diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index ed889feb77..fd601a3d49 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -1,18 +1,18 @@ - -**Complete this sentence** -THIS PULL REQUEST __ [IS/IS NOT] __ READY TO MERGE + + + **Feature or improvement description** - + **Related issue, if one exists** - + **Impacted areas of the software** - + **Additional supporting information** - + **Test results, if applicable** - + diff --git a/.github/actions/compile-and-test/entrypoint.sh b/.github/actions/compile-and-test/entrypoint.sh index 57ec3db74d..21be246f9b 100755 --- a/.github/actions/compile-and-test/entrypoint.sh +++ b/.github/actions/compile-and-test/entrypoint.sh @@ -1,38 +1,69 @@ #!/bin/bash -git fetch origin ${GITHUB_REF}:CI -git checkout CI -git submodule update - -# Print the current git info -echo `git status` -echo `git log -1` -cd /openfast/reg_tests/r-test -echo `git status` -echo `git log -1` -cd /openfast +verbosecommand() { echo ">>> $1" && eval $1 && echo "<<<"; } + +# Configure Bash to exit if any command returns an error +set -e + +verbosecommand "cd /openfast" + +repo="OpenFAST" +echo "GITHUB_EVENT_NAME: ${GITHUB_EVENT_NAME}" +if [[ "${GITHUB_EVENT_NAME}" != "pull_request" ]]; then + repo=${GITHUB_ACTOR} +fi +# Create a branch "CI" at the current commit from the GH Actor's fork. +verbosecommand "git fetch https://github.com/${repo}/openfast ${GITHUB_REF}:CI" +verbosecommand "git checkout CI" +verbosecommand "git submodule update" + +# Display the current git info +echo "*** git-status from openfast:" +verbosecommand "git status" + +echo "*** git-log from openfast:" +verbosecommand "git log -1" + +verbosecommand "cd /openfast/reg_tests/r-test" +echo "*** git-status from r-test:" +verbosecommand "git status" + +echo "*** git-log from r-test:" +verbosecommand "git log -1" + +verbosecommand "cd /openfast" + +# Display the differences between this commit and `dev` +echo "*** git-diff from ${GITHUB_REF} to dev:" +verbosecommand "git diff dev --numstat" # Move into the "build" directory, remove the old reg tests, and compile -cd /openfast/build -rm -rf reg_tests -cmake .. -make -j4 install +verbosecommand "cd /openfast/build" +verbosecommand "rm -rf reg_tests" +verbosecommand "cmake .." +verbosecommand "make -j4 install" # Run the tests # NWTC Library tests -ctest -VV -R nwtc_library_utest +verbosecommand "ctest -VV -R nwtc_library_utest" # BeamDyn-specific tests -ctest -VV -j7 -R bd_ -ctest -VV -R beamdyn_utest +verbosecommand "ctest -VV -j7 -R bd_" +verbosecommand "ctest -VV -R beamdyn_utest" + +# OLAF free vortex wake tests +ctest -VV -R fvw_utest # OpenFAST linearization tests # Dont run these in parallel, copying the case files can fail in a race condition -ctest -VV -L linear +# Exclude the Ideal_Beam test cases +# - They fail consistently in the Docker container when run on GitHub, +# but pass everywhere else including running the same Docker image locally +verbosecommand "ctest -VV -L linear -E Ideal" # Subset of OpenFAST regression tests; do not run ## - 9, 16 because they're very sensitive ## - 19, 20 because theyre too long -## - 17, 22, 23 becuase we dont know why they fail :( -ctest -VV -j8 -I 1,1,1,2,3,4,5,6,7,8,10,11,12,13,14,15,18,21,24,25 +## - 17, 22, 23 because we dont know why they fail :( +verbosecommand "ctest -VV -j8 -I 1,1,1,2,3,4,5,6,7,8,10,11,12,13,14,15,18,21,24,25,26,27,28,29" diff --git a/.github/workflows/continuous-integration-workflow.yml b/.github/workflows/continuous-integration-workflow.yml index 9644fd2f97..edd35ff242 100644 --- a/.github/workflows/continuous-integration-workflow.yml +++ b/.github/workflows/continuous-integration-workflow.yml @@ -15,8 +15,8 @@ jobs: name: OpenFAST tests on Ubuntu steps: - name: Checkout - uses: actions/checkout@master + uses: actions/checkout@main with: - submodule: recursive + submodules: recursive - name: Build and test step uses: ./.github/actions/compile-and-test diff --git a/.gitignore b/.gitignore index 8a3337ef1e..3827d6e222 100644 --- a/.gitignore +++ b/.gitignore @@ -41,6 +41,11 @@ vs-build/ .vscode .atom .fortls - # backup files *.asv +~$*.xlsx + +# LaTeX compiling files +*.aux +*.nlo +*.log diff --git a/.gitmodules b/.gitmodules index 5fb3759b96..9650d9f067 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "reg_tests/r-test"] path = reg_tests/r-test - url = https://github.com/openfast/r-test.git + url = https://github.com/OpenFAST/r-test.git [submodule "unit_tests/pfunit"] path = unit_tests/pfunit url = https://github.com/Goddard-Fortran-Ecosystem/pFUnit.git diff --git a/.readthedocs.yml b/.readthedocs.yml index 431543a33b..2a5338b5c2 100644 --- a/.readthedocs.yml +++ b/.readthedocs.yml @@ -5,9 +5,6 @@ # Required version: 2 -sphinx: - configuration: docs/conf.py - formats: - htmlzip - pdf diff --git a/.travis.yml b/.travis.yml index 82c62b1838..8010145f0f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -57,6 +57,9 @@ script: # beamdyn regression tests - if [[ "$DOUBLE_PRECISION" == "ON" ]]; then ctest -j4 -VV -R bd_; fi + # linearization cases + - if [[ "$DOUBLE_PRECISION" == "ON" ]]; then ctest -L linear; fi + # subset of openfast regression tests # do not run # - 3, 4, 7, 15, 16, 17 since the free yaw is not well trusted diff --git a/CMakeLists.txt b/CMakeLists.txt index 9ca7973818..e98907948c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -33,8 +33,9 @@ option(BUILD_SHARED_LIBS "Enable building shared libraries" off) option(DOUBLE_PRECISION "Treat REAL as double precision" on) option(USE_DLL_INTERFACE "Enable runtime loading of dynamic libraries" on) option(FPE_TRAP_ENABLED "Enable FPE trap in compiler options" off) -option(ORCA_DLL_LOAD "Enable OrcaFlex Library Load" off) +option(ORCA_DLL_LOAD "Enable OrcaFlex Library Load" on) option(BUILD_OPENFAST_CPP_API "Enable building OpenFAST - C++ API" off) +option(OPENMP "Enable OpenMP support" off) # Precompiler/preprocessor flag configuration # Do this before configuring modules so that the flags are included @@ -169,4 +170,4 @@ endif() option(BUILD_DOCUMENTATION "Build documentation." OFF) if(BUILD_DOCUMENTATION) add_subdirectory(docs) -endif() \ No newline at end of file +endif() diff --git a/README.rst b/README.rst index 07c7cf8a61..76e3affe43 100644 --- a/README.rst +++ b/README.rst @@ -29,7 +29,7 @@ FAST v8 - OpenFAST v0.1.0 The transition from FAST v8 to OpenFAST v0.1.0 represents the effort to better support an open-source developer community around FAST-based aero-hydro-servo- elastic engineering models of wind-turbines and wind-plants. OpenFAST is the -next generation of FAST analysis tools. More inforation is available in the +next generation of FAST analysis tools. More information is available in the `transition notes `_. FAST v8 is a computer-aided engineering tool for simulating the coupled dynamic @@ -114,15 +114,9 @@ Details for compiling `developing `_ OpenFAST on Unix-based and Windows machines are available at `readthedocs `_. -Nightly Testing ---------------- -The ``dev`` branch is automatically compiled and run through the test suite -nightly. The results are publicly available through the -`CDash Dashboard `_. - Help ---- -Please use `github issues `_ to: +Please use `GitHub Issues `_ to: * ask usage questions * report bugs diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index 786217cf8f..231c4f8008 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -73,6 +73,27 @@ macro(set_fast_fortran) endif() endmacro(set_fast_fortran) +# +# CHECK_F2008_FEATURES - Check if Fortran2008 features are available +# +macro(check_f2008_features) + include(CheckFortranSourceCompiles) + check_fortran_source_compiles( + "program test + use iso_fortran_env, only: compiler_version, real32, real64, real128 + integer, parameter :: quki = real128 + integer, parameter :: dbki = real64 + integer, parameter :: reki = real32 + + end program test" + HAS_FORTRAN2008 + SRC_EXT F90) + if (HAS_FORTRAN2008) + message(STATUS "Enabling Fortran 2008 features") + add_definitions(-DHAS_FORTRAN2008_FEATURES) + endif() +endmacro(check_f2008_features) + # # SET_FAST_GFORTRAN - Customizations for GNU Fortran compiler # @@ -83,17 +104,18 @@ macro(set_fast_gfortran) endif(NOT WIN32) # Fix free-form compilation for OpenFAST + #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -cpp -fopenmp") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -cpp") # Deal with Double/Single precision if (DOUBLE_PRECISION) - add_definitions(-DDOUBLE_PRECISION) + add_definitions(-DOPENFAST_DOUBLE_PRECISION) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") endif (DOUBLE_PRECISION) # debug flags if(CMAKE_BUILD_TYPE MATCHES Debug) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fcheck=all -pedantic -fbacktrace" ) + set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fcheck=all -pedantic -fbacktrace " ) endif() if(CYGWIN) @@ -102,6 +124,13 @@ macro(set_fast_gfortran) set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS},--stack,${stack_size}") endif() + # OPENMP + if (OPENMP) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fopenmp") + set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fopenmp" ) + endif() + + check_f2008_features() endmacro(set_fast_gfortran) # @@ -123,7 +152,7 @@ macro(set_fast_intel_fortran_posix) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic -fpp") # Deal with Double/Single precision if (DOUBLE_PRECISION) - add_definitions(-DDOUBLE_PRECISION) + add_definitions(-DOPENFAST_DOUBLE_PRECISION) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -double_size 128") endif (DOUBLE_PRECISION) @@ -131,6 +160,14 @@ macro(set_fast_intel_fortran_posix) if(CMAKE_BUILD_TYPE MATCHES Debug) set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -check all -traceback" ) endif() + + # OPENMP + if (OPENMP) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qopenmp") + set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -qopenmp" ) + endif() + + check_f2008_features() endmacro(set_fast_intel_fortran_posix) # @@ -145,7 +182,7 @@ macro(set_fast_intel_fortran_windows) # Deal with Double/Single precision if (DOUBLE_PRECISION) - add_definitions(-DDOUBLE_PRECISION) + add_definitions(-DOPENFAST_DOUBLE_PRECISION) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /real_size:64 /double_size:128") endif (DOUBLE_PRECISION) @@ -157,4 +194,12 @@ macro(set_fast_intel_fortran_windows) if(CMAKE_BUILD_TYPE MATCHES Debug) set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} /check:all /traceback" ) endif() + + # OPENMP + if (OPENMP) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /qopenmp") + set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} /qopenmp" ) + endif() + + check_f2008_features() endmacro(set_fast_intel_fortran_windows) diff --git a/docs/OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf b/docs/OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf new file mode 100644 index 0000000000..c76aba8f12 Binary files /dev/null and b/docs/OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf differ diff --git a/docs/OtherSupporting/DCM_Interpolation/DCM_Interpolation.tex b/docs/OtherSupporting/DCM_Interpolation/DCM_Interpolation.tex new file mode 100644 index 0000000000..aab546d93e --- /dev/null +++ b/docs/OtherSupporting/DCM_Interpolation/DCM_Interpolation.tex @@ -0,0 +1,238 @@ +%---------------------------------------------------------- +% + +\documentclass[10pt,letterpaper,oneside,notitlepage]{article} +%\documentclass{report}% +\usepackage{algorithm} +\usepackage{algpseudocode} +\usepackage{enumitem} +\usepackage{nomencl} +\usepackage{amsmath}% +%\usepackage{amsfonts}% +%\usepackage{amssymb}% +%\usepackage{graphicx} +%---------------------------------------------------------- +\makenomenclature +%\theoremstyle{plain} +%\newtheorem{acknowledgement}{Acknowledgement} +%\newtheorem{definition}{Definition} +%\newtheorem{remark}{Remark} +%\numberwithin{equation}{section} +%----------------------------------------------------------- +\begin{document} +\title{Interpolation of DCMs} +\author{Bonnie Jonkman} +\maketitle + + +\section{Logarithmic maps for DCMs} + +For any direction cosine matrix (DCM), $\Lambda$, +the logarithmic map for the matrix is a skew-symmetric matrix, $\lambda$: + + +\begin{equation} +\label{EqLog} +\lambda += \log( \Lambda ) += \begin{bmatrix} + 0 & \lambda_3 & -\lambda_2 \\ + -\lambda_3 & 0 & \lambda_1 \\ + \lambda_2 & -\lambda_1 & 0 + \end{bmatrix} +\end{equation} + +\section{Matrix exponentials} + +The angle of rotation for the skew-symmetric matrix, $\lambda$ is +\begin{equation} +\label{EqRotationAng} +\theta = \left\|\lambda\right\| = \sqrt{{\lambda_1}^2+{\lambda_2}^2+{\lambda_3}^2} +\end{equation} + +The matrix exponential is +\begin{equation} +\label{EqExp} + \Lambda = \exp(\lambda) = + \left\{ + \begin{matrix} + I & \theta = 0 \\ + I + \frac{\sin\theta}{\theta}\lambda + \frac{1-\cos\theta}{\theta^2}\lambda^2 & \theta > 0 \\ + \end{matrix} + \right. +\end{equation} + + +\section{Solving for $\lambda$} + +If the logarithmic map and matrix exponential are truly inverses, we need +\begin{equation} +\exp(\log(\Lambda)) = \Lambda. +\end{equation} +Using the expression for $\lambda$ from Equation \ref{EqLog}, we get +\begin{equation} +\label{EqExpMatrix} + \exp\left( + \begin{bmatrix} + 0 & \lambda_3 & -\lambda_2 \\ + -\lambda_3 & 0 & \lambda_1 \\ + \lambda_2 & -\lambda_1 & 0 + \end{bmatrix} +\right) = \Lambda = + \begin{bmatrix} + \Lambda_{11} & \Lambda_{12} & \Lambda_{13} \\ + \Lambda_{21} & \Lambda_{22} & \Lambda_{23} \\ + \Lambda_{31} & \Lambda_{32} & \Lambda_{33} \\ + \end{bmatrix} +\end{equation} + +Doing a little algebra for $\theta > 0$, Equation \ref{EqExpMatrix} becomes +\begin{equation} +\label{EqMatrixAlgebra} +\Lambda = + \begin{bmatrix} + 1-\frac{1-\cos\theta}{\theta^2}\left( \lambda_3^2 + \lambda_2^2\right) +& \frac{\sin\theta}{\theta}\lambda_3+\frac{1-\cos\theta}{\theta^2}\lambda_1\lambda_2 +& -\frac{\sin\theta}{\theta}\lambda_2+\frac{1-\cos\theta}{\theta^2}\lambda_1\lambda_3 \\ + -\frac{\sin\theta}{\theta}\lambda_3+\frac{1-\cos\theta}{\theta^2}\lambda_1\lambda_2 +& 1-\frac{1-\cos\theta}{\theta^2}\left( \lambda_3^2 + \lambda_1^2\right) +& \frac{\sin\theta}{\theta}\lambda_1+\frac{1-\cos\theta}{\theta^2}\lambda_2\lambda_3 \\ + \frac{\sin\theta}{\theta}\lambda_2+\frac{1-\cos\theta}{\theta^2}\lambda_1\lambda_3 +& -\frac{\sin\theta}{\theta}\lambda_1+\frac{1-\cos\theta}{\theta^2}\lambda_2\lambda_3 +& 1-\frac{1-\cos\theta}{\theta^2}\left( \lambda_2^2 + \lambda_1^2\right) \\ + \end{bmatrix} +\end{equation} +It follows that the trace is +\begin{eqnarray*} +\mathrm{Tr}(\Lambda) &=& 3 - 2\frac{1-\cos\theta}{\theta^2}(\lambda_1^2 + \lambda_2^2 + \lambda_3^2) \\ + &=& 3 - 2\left(1-\cos\theta\right) \\ + &=& 1 + 2\cos\theta +\end{eqnarray*} or +\begin{equation} +\theta= \begin{matrix} \cos^{-1}\left(\frac{1}{2}\left(\mathrm{Tr}(\Lambda)-1\right)\right) & \theta \in \left[0,\pi\right]\end{matrix} +\end{equation} +It also follows that +\begin{equation} +\Lambda - \Lambda^T=\frac{2\sin\theta}{\theta} + \begin{bmatrix} + 0 & \lambda_3 & -\lambda_2 \\ + -\lambda_3 & 0 & \lambda_1 \\ + \lambda_2 & -\lambda_1 & 0 \\ + \end{bmatrix} +\end{equation} or, when $\sin\theta \neq 0$ +\begin{equation} +\label{EqLambdaSinNot0} +\lambda = \frac{\theta}{2\sin\theta} \left( \Lambda - \Lambda^T\right) +\end{equation} +We need an equation that works when $\sin\theta$ approaches 0, that is, when $\theta$ approaches 0 or $\theta$ approaches $\pi$. When $\theta$ approaches 0, Equation \ref{EqLambdaSinNot0} actually behaves well: +\begin{equation} +\lim_{\theta \to 0}\frac{\theta}{2\sin\theta} = \frac{1}{2} +\end{equation} +and since $\theta$ is the $l_2$ norm of the individual components of $\lambda$, it follows that they approach zero, and we get +\begin{equation} +\label{EqLambdaTheta0} +\lambda = 0 +\end{equation} +However, when $\theta$ approaches $\pi$, $\Lambda - \Lambda^T$ approaches 0, and +\begin{equation} +\lim_{\theta \to \pi}\frac{\theta}{2\sin\theta} = \infty +\end{equation} +We need a different method to find $\lambda$. Going back to Equations \ref{EqExpMatrix} and \ref{EqMatrixAlgebra}, we can compute the following: +\begin{equation} +\Lambda_{11}+\Lambda_{22}-\Lambda_{33} = 1 - \frac{2\lambda_3^2(1-\cos\theta)}{\theta^2} +\end{equation} +%\begin{equation} +%\Lambda_{11}-\Lambda_{22}+\Lambda{33} = 1 - \frac{1-\cos\theta}{\theta^2}\left( 2\lambda_2^2\right) +%\end{equation} +%\begin{equation} +%-\Lambda_{11}+\Lambda_{22}+\Lambda{33} = 1 - \frac{1-\cos\theta}{\theta^2}\left( 2\lambda_1^2\right) +%\end{equation} +or +\begin{equation} +\label{EqLambda3} +\lambda_3 = \pm \theta\sqrt{ \frac{\left(1 + \Lambda_{33} - \Lambda_{11} - \Lambda_{22}\right)}{2\left(1-\cos\theta\right)} } +\end{equation} +Equations for the other two components of $\lambda$ are similar: +\begin{equation} +\label{EqLambda1} +\lambda_1 = \pm \theta\sqrt{ \frac{\left(1 + \Lambda_{11} - \Lambda_{22} - \Lambda_{33}\right)}{2\left(1-\cos\theta\right)} } +\end{equation} +\begin{equation} +\label{EqLambda2} +\lambda_2 = \pm \theta\sqrt{ \frac{\left(1 + \Lambda_{22} - \Lambda_{11} - \Lambda_{33}\right)}{2\left(1-\cos\theta\right)} } +\end{equation} +Equations \ref{EqLambda3}-\ref{EqLambda2} give us the magnitude, not the sign of the vector we are looking for. Here is one possibility for choosing the sign: +If $(\lambda_1) \neq 0$, choose $\mathrm{sign}(\lambda_1)$ positive. +\begin{equation} +\Lambda_{12}+\Lambda_{21} = \frac{2\left(1-\cos\theta\right)}{\theta^2}\lambda_1\lambda_2 +\end{equation} +so +\begin{equation} +\mathrm{sign}(\lambda_2) = \mathrm{sign}(\Lambda_{12}+\Lambda_{21}) +\end{equation} +and similarly, +\begin{equation} +\mathrm{sign}(\lambda_3) = \mathrm{sign}(\Lambda_{13}+\Lambda_{31}) +\end{equation} +If $(\lambda_1) = 0$, similar arguments can be used to choose $\mathrm{sign}(\lambda_2)$ positive, and +\begin{equation} +\mathrm{sign}(\lambda_3) = \mathrm{sign}(\Lambda_{23}+\Lambda_{32}) +\end{equation} +At this point, the relationships between the components of $\lambda$ are set, so we have computed $\pm\lambda$. If $\theta=\pi$, both values are a solution, so this good enough. + +If $\theta$ is close to $\pi$, we will need to determine if we have the negative of the solution. This is required for numerical stability of the solution. +In this case, $\Lambda-\Lambda^T$ is not exactly zero, so we can look at the sign of the solution we would have computed if we had used Equation \ref{EqLambdaSinNot0}: +\begin{equation} +\Lambda_{23}-\Lambda_{32} = \left|\frac{2\sin\theta}{\theta}\right|\lambda_1 +\end{equation} +\begin{equation} +\Lambda_{31}-\Lambda_{13} = \left|\frac{2\sin\theta}{\theta}\right|\lambda_2 +\end{equation} +\begin{equation} +\Lambda_{12}-\Lambda_{21} = \left|\frac{2\sin\theta}{\theta}\right|\lambda_3 +\end{equation} +For numerical reasons, we don't want to use these equations to get the magnitude of the components of $\lambda$, but we can look at the sign of the element with largest magnitude and ensure our $\lambda$ has the same sign. + +\section{Interpolation} +\subsection{Periodicity of solutions} + +Given $\lambda_k = \lambda \left( 1 + \frac{2k\pi}{\left\| \lambda \right\|}\right)$ for any integer $k$, it follows that +\begin{equation} +\theta_k = \left| 1 + \frac{2k\pi}{\left\|\lambda\right\|}\right| \theta +\end{equation} +or +\begin{equation} +\theta_k = \left|\theta + 2k\pi\right| +\end{equation} + +\begin{eqnarray*} +\Lambda_k +&=& \exp(\lambda_k) \\ +&=& I + \frac{\sin\theta_k}{\theta_k}\lambda_k + \frac{1-\cos\theta_k}{\theta_k^2}\lambda_k^2 \\ +&=& I + \frac{\sin\left|\theta + 2k\pi\right|}{\left|\theta + 2k\pi\right|}\left( \frac{\theta+2k\pi}{\theta}\right)\lambda + \frac{1-\cos\left|\theta + 2k\pi\right|}{\left|\theta + 2k\pi\right|^2}\left(\frac{\theta+2k\pi}{\theta}\right)^2\lambda^2 \\ +&=& I + \frac{\sin\left|\theta + 2k\pi\right|}{\theta} + \frac{\theta + 2k\pi}{\left|\theta + 2k\pi\right|}\lambda + \frac{1-\cos\left|\theta + 2k\pi\right|}{\theta^2}\lambda^2\\ +&=& I + \frac{\sin\theta}{\theta} \lambda + \frac{1-\cos\theta}{\theta^2}\lambda^2\\ +&=& \exp(\lambda) \\ +&=& \Lambda \\ +\end{eqnarray*} + +Thus, if $\lambda$ is one solution to $\log(\Lambda)$, then so is +$\lambda_k = \lambda \left( 1 + \frac{2k\pi}{\left\| \lambda \right\|}\right)$ for any integer k. + +\subsection{Finding values of $\lambda$ for interpolation} +Given a set of $\lambda^j$ to be interpolated, find equivalent $\tilde{\lambda}^j$ for integers $j=1,2,...n$: +Set $\tilde{\lambda}^1 = \lambda^1$. +For each $j\in\left[2,n\right]$, +check to see if $\tilde{\lambda}^{j-1}$ is closer (in the $l_2$-norm sense) to +$\lambda^j$ or $\lambda^j \left( 1 + \frac{2\pi}{\left\| \lambda^j \right\|}\right)$. +If the latter, set $\tilde{\lambda}^{j}=\lambda^j \left( 1 + \frac{2\pi}{\left\| \lambda^j \right\|}\right)$ and continue checking if we need to add more $2\pi$ periods. +Otherwise, check to see if $\tilde{\lambda}^{j-1}$ is closer to +$\lambda^j$ or $\lambda^j \left( 1 - \frac{2\pi}{\left\| \lambda^j \right\|}\right)$. +If the latter, set $\tilde{\lambda}^{j}=\lambda^j \left( 1 - \frac{2\pi}{\left\| \lambda^j \right\|}\right)$ and continue checking if we need to subtract more $2\pi$ periods. +Otherwise set $\tilde{\lambda}^{j} = \lambda^j$. + + +Interpolation must occur on the $\tilde{\lambda}^{j}$ and not the $\lambda^j$. + +\end{document} \ No newline at end of file diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf new file mode 100644 index 0000000000..7f2f80bfb8 Binary files /dev/null and b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf differ diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex new file mode 100644 index 0000000000..8894cd1030 --- /dev/null +++ b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex @@ -0,0 +1,564 @@ +%---------------------------------------------------------- +% + +\documentclass[10pt,letterpaper,oneside,notitlepage]{article} +%\documentclass{report}% +\usepackage{algorithm} +\usepackage{algpseudocode} +\usepackage{enumitem} +\usepackage{nomencl} +\usepackage{amsmath} +\usepackage{amssymb} +%\usepackage{amsfonts}% +%\usepackage{graphicx} +%---------------------------------------------------------- +\makenomenclature +%\theoremstyle{plain} +%\newtheorem{acknowledgement}{Acknowledgement} +%\newtheorem{definition}{Definition} +%\newtheorem{remark}{Remark} +%\numberwithin{equation}{section} +%----------------------------------------------------------- +\begin{document} +\title{Algorithms in OpenFAST v2} +\author{Bonnie Jonkman} +%\begin{abstract} +%This document is used to describe the algorithms implemented in FAST v8. +%\end{abstract} +\maketitle + +%\tableofcontents + +\section{Definitions and Nomenclature} + + +\begin{table}[h] + \centering + \begin{tabular}{c|c|c} + \textbf{Module} & \textbf{Abbreviation} & \textbf{Abbreviation}\\ + \textbf{Name} & \textbf{in Module} & \textbf{in this Document}\\ + \hline + ElastoDyn & ED & ED \\ + BeamDyn & BD & BD \\ + AeroDyn14 & AD14 & AD14 \\ + AeroDyn & AD & AD \\ + ServoDyn & SrvD & SrvD \\ + SubDyn & SD & SD \\ + HydroDyn & HydroDyn & HD \\ + MAP++ & MAPp & MAP \\ + FEAMooring & FEAM & FEAM \\ + MoorDyn & MD & MD \\ + OrcaFlexInterface & Orca & Orca \\ + InflowWind & IfW & IfW \\ + IceFloe & IceFloe & IceF \\ + IceDyn & IceD & IceD \\ + \end{tabular} + \caption{Abbreviations for modules in FAST v8} + \label{tab:Abbrev} +\end{table} + + +\nomenclature{$u\_ED$}{$ElastoDyn$ inputs} +\nomenclature{$u\_AD$}{$AeroDyn$ inputs} +\printnomenclature + +\section{Initializations} + + +\pagebreak %break here for now so that it doesn't look so strange +\section{Input-Output Relationships} +\subsection {Input-Output Solves (Option 2 Before 1)} +This algorithm documents the procedure for the Input-Output solves in FAST, assuming +all modules are in use. If an individual module is not in use during a particular +simulation, the calls to that module's subroutines are omitted and the module's +inputs and outputs are neither set nor used. + +%\begin{algorithm}[ht] +%\caption{Input-Output Solves (Option 2 Before 1)} +%\label{IOSolves21} +\begin{algorithmic}[1] +\Procedure{CalcOutputs\_And\_SolveForInputs}{\null} +\State $\mathit{y\_ED} \gets \Call{ED\_CalcOutput}{\mathit{p\_ED},\mathit{u\_ED},\mathit{x\_ED},\mathit{xd\_ED},\mathit{z\_ED}}$ + +\State + \State $\mathit{u\_AD}($not InflowWind$) \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED}}$ + + \State $\mathit{u\_IfW} \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED} at \mathit{u\_AD} nodes}$ + \State $\mathit{y\_IfW} \gets \Call{IfW\_CalcOutput}{\mathit{u\_IfW} and other \mathit{IfW} data structures}$ + + \State $\mathit{u\_AD}($InflowWind only$) \gets \Call{TransferOutputsToInputs}{\mathit{y\_IfW}}$ + \State $\mathit{y\_AD} \gets \Call{AD\_CalcOutput}{\mathit{p\_AD},\mathit{u\_AD},\mathit{x\_AD},\mathit{xd\_AD},\mathit{z\_AD}}$ + +\State + \State $\mathit{u\_SrvD} \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED},\mathit{y\_IfW}}$ + \State $\mathit{y\_SrvD} \gets \Call{SrvD\_CalcOutput}{}( \! + \begin{aligned}[t] + & \mathit{p\_SrvD},\mathit{u\_SrvD}, \\ + & \mathit{x\_SrvD},\mathit{xd\_SrvD},\mathit{z\_SrvD}) \\ + \end{aligned}$ + +\State + \State $\mathit{u\_ED}($not platform reference point$) \gets \Call{TransferOutputsToInputs}{y\_SrvD,y\_AD}$ %\Comment{sets all but platform reference point inputs} + + \State $\mathit{u\_HD} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + \State $\mathit{u\_SD} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + \State $\mathit{u\_MAP} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + \State $\mathit{u\_FEAM} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + +\State +\State \Call{ED\_HD\_SD\_Mooring\_Ice\_InputOutputSolve}{\null} +\State +\State $\mathit{u\_AD} \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED}}$ +\State $\mathit{u\_SrvD} \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED},\mathit{y\_AD}}$ + +\EndProcedure +\end{algorithmic} +%\end{algorithm} + +Note that inputs to $ElastoDyn$ before calling CalcOutput() in the first step are not set in CalcOutputs\_And\_SolveForInputs(). +Instead, the $ElastoDyn$ inputs are set depending on where CalcOutputs\_And\_SolveForInputs() is called: +\begin{itemize}[noitemsep] %i don't like the double spaces between bulleted items. + \item At time 0, the inputs are the initial guess from $ElastoDyn$; + \item On the prediction step, the inputs are extrapolated values from the time history of ElastoDyn inputs; + \item On the first correction step, the inputs are the values calculated in the prediction step; + \item On subsequent correction steps, the inputs are the values calculated in the previous correction step. +\end{itemize} + + +%\pagebreak %break here for now so that it doesn't look so strange +%\subsection {Input-Output Solve for $HydroDyn$, $SubDyn$, $MAP$, \\ +% $FEAMooring$, $IceFloe$, and the Platform Reference Point Mesh in $ElastoDyn$} +\subsection {Input-Output Solve for \textit{HydroDyn}, \textit{SubDyn}, \textit{MAP}, + \textit{FEAMooring}, \textit{IceFloe}, and the Platform Reference Point Mesh in \textit{ElastoDyn}} + +This procedure implements Solve Option 1 for the accelerations and loads in +$HydroDyn$, $SubDyn$, $MAP$, $FEAMooring$, and $ElastoDyn$ (at its platform reference point mesh). +The other input-output relationships for these modules are solved using Solve Option 2. + +%\begin{algorithm}[ht] +%\caption{Input-Output Solve for $HydroDyn$, $SubDyn$, $MAP$, $FEAMooring$, and the Platform Reference Point Mesh in $ElastoDyn$} +%\label{IOSolves_PlatformRef} +\begin{algorithmic}[1] + +\Procedure{ED\_HD\_SD\_Mooring\_Ice\_InputOutputSolve}{\null} + \State + \State $\mathit{y\_MAP} \gets \Call{CalcOutput}{\mathit{p\_MAP},\mathit{u\_MAP},\mathit{x\_MAP},\mathit{xd\_MAP},\mathit{z\_MAP}}$ + \State $\mathit{y\_FEAM} \gets \Call{CalcOutput}{\mathit{p\_FEAM},\mathit{u\_FEAM},\mathit{x\_FEAM},\mathit{xd\_FEAM},\mathit{z\_FEAM}}$ + \State $\mathit{y\_IceF} \gets \Call{CalcOutput}{\mathit{p\_IceF},\mathit{u\_IceF},\mathit{x\_IceF},\mathit{xd\_IceF},\mathit{z\_IceF}}$ + \State $\mathit{y\_IceD(:)} \gets \Call{CalcOutput}{\mathit{p\_IceD(:)},\mathit{u\_IceD(:)},\mathit{x\_IceD(:)},\mathit{xd\_IceD(:)},\mathit{z\_IceD(:)}}$ + \State + \State\Comment{Form $u$ vector using loads and accelerations from $\mathit{u\_HD}$, $\mathit{u\_SD}$, and platform reference input from $\mathit{u\_ED}$} + \State + \State $u \gets \Call{u\_vec}{\mathit{u\_HD},\mathit{u\_SD},\mathit{u\_ED}}$ + \State $k \gets 0$ + \Loop\Comment{Solve for loads and accelerations (direct feed-through terms)} + \State $y\_ED \gets \Call{ED\_CalcOutput}{\mathit{p\_ED},\mathit{u\_ED},\mathit{x\_ED},\mathit{xd\_ED},\mathit{z\_ED}}$ + \State $y\_SD \gets \Call{SD\_CalcOutput}{\mathit{p\_SD},\mathit{u\_SD},\mathit{x\_SD},\mathit{xd\_SD},\mathit{z\_SD}}$ + \State $y\_HD \gets \Call{HD\_CalcOutput}{\mathit{p\_HD},\mathit{u\_HD},\mathit{x\_HD},\mathit{xd\_HD},\mathit{z\_HD}}$ + + \If{ $k \geq k\_max$} + \State exit loop + \EndIf + + \State$\mathit{u\_MAP\_tmp} \gets \Call{TransferMeshMotions}{y\_ED}$ + \State$\mathit{u\_FEAM\_tmp} \gets \Call{TransferMeshMotions}{y\_ED}$ + \State$\mathit{u\_IceF\_tmp} \gets \Call{TransferMeshMotions}{y\_SD}$ + \State$\mathit{u\_IceD\_tmp(:)} \gets \Call{TransferMeshMotions}{y\_SD}$ + \State$\mathit{u\_HD\_tmp} \gets \Call{TransferMeshMotions}{y\_ED,y\_SD}$ + \State$\mathit{u\_SD\_tmp} \gets \! + \begin{aligned}[t] + & \Call{TransferMeshMotions}{\mathit{y\_ED}} \\ + & \cup \Call{TransferMeshLoads}{}(\! + \begin{aligned}[t] + & \mathit{y\_SD}, \\ + & \mathit{y\_HD},\mathit{u\_HD\_tmp}, \\ + & \mathit{y\_IceF},\mathit{u\_IceF\_tmp}) \\ + & \mathit{y\_IceD(:)},\mathit{u\_IceD\_tmp(:)}) \\ + \end{aligned} + \end{aligned}$ + \State$\mathit{u\_ED\_tmp} \gets \Call{TransferMeshLoads}{}( \! + \begin{aligned}[t] & \mathit{y\_ED}, \\ + & \mathit{y\_HD}, \mathit{u\_HD\_tmp}, \\ + & \mathit{y\_SD}, \mathit{u\_SD\_tmp}, \\ + & \mathit{y\_MAP}, \mathit{u\_MAP\_tmp}, \\ + & \mathit{y\_FEAM},\mathit{u\_FEAM\_tmp} ) + \end{aligned}$ + + \State + \State$\mathit{U\_Residual} \gets u - \Call{u\_vec}{\mathit{u\_HD\_tmp},\mathit{u\_SD\_tmp},\mathit{u\_ED\_tmp}}$ + \State + + \If{ last Jacobian was calculated at least $\mathit{DT\_UJac}$ seconds ago } + \State Calculate $\frac{\partial U}{\partial u}$ + \EndIf + + %\textit{ + %\State Perturb each input in $u$ + %\State Call $\Call{CalcOutput}{p,u,x,xd,z}$ for each module + %\State Transfer perturbed outputs to inputs + %\State Form new $u$ + %\State Compare new $u$ with $U\_Residual$ + %\State} + + \State Solve $\frac{\partial U}{\partial u} \Delta u = - \mathit{U\_Residual}$ for $\Delta u$ + + \State + \If{$\lVert \Delta u \rVert_2 < $ tolerance } \Comment{To be implemented later} + \State exit loop + \EndIf + \State + \State $u \gets u + \Delta u$ + \State Transfer $u$ to $\mathit{u\_HD}$, $\mathit{u\_SD}$, and $\mathit{u\_ED}$\Comment{loads and accelerations only} + \State $k=k+1$ + + \EndLoop + + \State\Comment{Transfer non-acceleration fields to motion input meshes} + \State + + \State$\mathit{u\_HD}($not accelerations$) \gets \Call{TransferMeshMotions}{\mathit{y\_ED},\mathit{y\_SD}}$ + \State$\mathit{u\_SD}($not accelerations$) \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + \State + \State $\mathit{u\_MAP} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + \State $\mathit{u\_FEAM} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + \State $\mathit{u\_IceF} \gets \Call{TransferMeshMotions}{\mathit{y\_SD}}$ + \State $\mathit{u\_IceD(:)} \gets \Call{TransferMeshMotions}{\mathit{y\_SD}}$ + +\EndProcedure + +\end{algorithmic} +%\end{algorithm} + +\subsection {Implementation of line2-to-line2 loads mapping} +The inverse-lumping of loads is computed by a block matrix solve for the distributed forces and moments, +using the following equation: + +\begin{equation} +\label{EqLump} + \begin{bmatrix} + F^{DL} \\ + M^{DL} \\ + \end{bmatrix} += + \begin{bmatrix} + A & 0 \\ + B & A \\ + \end{bmatrix} + \begin{bmatrix} + F^{D} \\ + M^{D} \\ + \end{bmatrix} +\end{equation} + +Because the forces do not depend on the moments, we first solve for the distributed forces, $F^D$: +\begin{equation} +\label{EqLumpF} + \begin{bmatrix} F^{DL} \\ \end{bmatrix} += + \left[ A \right] + \left[ F^{D} \right] +\end{equation} + +We then use the known values to solve for the distributed moments, $M^D$: +\begin{equation} +\label{EqLumpM1} + \left[ M^{DL} \right] += + \begin{bmatrix} B & A \\ \end{bmatrix} + \begin{bmatrix} + F^{D} \\ + M^{D} \\ + \end{bmatrix} += \left[ B \right] \left[ F^D \right] + \left[ A \right] \left[ M^D \right] +\end{equation} +or +\begin{equation} +\label{EqLumpM2} +\left[ M^{DL} \right] - \left[ B \right] \left[ F^D \right] = \left[ A \right] \left[ M^D \right] +\end{equation} +Rather than store the matrix $B$, we directly perform the cross products that the matrix $B$ represents. +This makes the left-hand side of Equation \ref{EqLumpM2} known, leaving us with one matrix solve. This +solve uses the same matrix $A$ used to obtain the distributed forces in Equation \ref{EqLumpF}; $A$ depends +only on element reference positions and connectivity. We use +the $LU$ factorization of matrix $A$ so that the second solve does not introduce much additional overhead. + + + +\pagebreak %break here for now so that it doesn't look so strange +\section{Solve Option 2 Improvements} +\subsection {Input-Output Solves inside AdvanceStates} +This algorithm documents the procedure for advancing states with option 2 +Input-Output solves in FAST, assuming +all modules are in use. If an individual module is not in use during a particular +simulation, the calls to that module's subroutines are omitted and the module's +inputs and outputs are neither set nor used. + +\begin{algorithmic}[1] +\Procedure{FAST\_AdvanceStates}{\null} +\State $\Call{ED\_UpdateStates}{\mathit{p\_ED},\mathit{u\_ED},\mathit{x\_ED},\mathit{xd\_ED},\mathit{z\_ED}}$ +\State $\mathit{y\_ED} \gets \Call{ED\_CalcOutput}{\mathit{p\_ED},\mathit{u\_ED},\mathit{x\_ED},\mathit{xd\_ED},\mathit{z\_ED}}$ +\State +\State $\mathit{u\_BD}($hub and root motions$) \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED}}$ +\State $\Call{BD\_UpdateStates}{\mathit{p\_BD},\mathit{u\_BD},\mathit{x\_BD},\mathit{xd\_BD},\mathit{z\_BD}}$ +\State $\mathit{y\_BD} \gets \Call{BD\_CalcOutput}{\mathit{p\_BD},\mathit{u\_BD},\mathit{x\_BD},\mathit{xd\_BD},\mathit{z\_BD}}$ +\State +\State $\mathit{u\_AD}($not InflowWind$) \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED},\mathit{y\_BD}}$ +\State $\mathit{u\_IfW} \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED},\mathit{y\_BD}$ at $\mathit{u\_AD}$ nodes$}$ +\State $\Call{IfW\_UpdateStates}{\mathit{p\_IfW},\mathit{u\_IfW},\mathit{x\_IfW},\mathit{xd\_IfW},\mathit{z\_IfW}}$ +\State $\mathit{y\_IfW} \gets \Call{IfW\_CalcOutput}{\mathit{u\_IfW}$ and other $\mathit{IfW}$ data structures$}$ +\State +\State $\mathit{u\_AD}($InflowWind only$) \gets \Call{TransferOutputsToInputs}{\mathit{y\_IfW}}$ +\State $\mathit{u\_SrvD} \gets \Call{TransferOutputsToInputs}{\mathit{y\_ED},\mathit{y\_BD},\mathit{y\_IfW}}$ +\State $\Call{AD\_UpdateStates}{\mathit{p\_AD},\mathit{u\_AD},\mathit{x\_AD},\mathit{xd\_AD},\mathit{z\_AD}}$ +\State $\Call{SrvD\_UpdateStates}{\mathit{p\_SrvD},\mathit{u\_SrvD},\mathit{x\_SrvD},\mathit{xd\_SrvD},\mathit{z\_SrvD}}$ +\State +\State All other modules (used in Solve Option 1) advance their states +\EndProcedure +\end{algorithmic} + +Note that AeroDyn and ServoDyn outputs get calculated inside the ${CalcOutputs\_And\_SolveForInputs}$ routine. ElastoDyn, BeamDyn, and +InflowWind outputs do not get recalculated in ${CalcOutputs\_And\_SolveForInputs}$ except for the first time the routine is called +(because CalcOutput is called before UpdateStates at time 0). + + + +\section {Linearization} +\subsection{Loads Transfer} +The loads transfer can be broken down into four components, all of which are used in the Line2-to-Line2 loads transfer: +\begin{enumerate} + \item Augment the source mesh with additional nodes. + \item Lump the distributed loads on the augmented Line2 source mesh to a Point mesh. + \item Perform Point-to-Point loads transfer. + \item Distribute (or "unlump") the point loads. +\end{enumerate} +The other loads transfers are just subsets of the Line2-to-Line2 transfer: +\begin{itemize} + \item Line2-to-Line2: Perform steps 1, 2, 3, and 4. + \item Line2-to-Point: Perform steps 1, 2, and 3. + \item Point-to-Line2: Perform steps 3 and 4. + \item Point-to-Point: Perform step 3. +\end{itemize} + + +Each of the four steps can be represented with a linear equation. The linearization of the loads transfers is just multiplying the +appropriate matrices generated in each of the steps. + + +\subsubsection{Step 1: Augment the source mesh} +The equation that linearizes mesh augmentation is +\begin{equation} +\label{Augment} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{SA} \\ \vec{f}^{SA} \\ \vec{m}^{SA} \end{matrix} \right\} += + \begin{bmatrix} + I_{\mathit{N_D}} & 0 & 0 & 0 \\ + 0 & M^A & 0 & 0 \\ + 0 & 0 & M^A & 0 \\ + 0 & 0 & 0 & M^A \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^S \\ \vec{f}^S \\ \vec{m}^S \end{matrix} \right\} +\end{equation} +where $M^A \in \mathbb{R}^{ \mathit{N_{SA}},\mathit{N_{S}}}$ indicates the mapping of nodes from the source mesh (with $N_S$ nodes) to the augmented source mesh +(with $N_{SA}$ nodes). The destination mesh (with $N_D$ nodes) is unchanged, as is indicated by matrix $I_{\mathit{N_D}}$. + + + +\subsubsection{Step 2: Lump loads on a Line2 mesh to a Point mesh} +The equation that linearizes the lumping of loads is +\begin{equation} +\label{Lump} + \left\{ \begin{matrix} \vec{u}^{SA} \\ \vec{F}^{SAL} \\ \vec{M}^{SAL} \end{matrix} \right\} += + \begin{bmatrix} + I_{\mathit{N_{SA}}} & 0 & 0 \\ + 0 & M_{li}^{SL} & 0 \\ + M_{uS}^{SL} & M_{f}^{SL} & M_{li}^{SL} \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^{SA} \\ \vec{f}^{SA} \\ \vec{m}^{SA} \end{matrix} \right\} +\end{equation} +where $M_{li}^{SL}, M_{uS}^{SL}, M_{f}^{SL} \in \mathbb{R}^{ \mathit{N_{SA}},\mathit{N_{SA}}}$ are block matrices that indicate the mapping of the lumped values to distributed values. $M_{li}^{SL}$ is matrix $A$ in Equation \ref{EqLumpF}, which depends only on element reference positions and connectivity. Matrices $M_{uS}^{SL}$and $M_{f}^{SL}$ also depend on values at their operating point. + + +\subsubsection{Step 3: Perform Point-to-Point loads transfer} +The equation that performs Point-to-Point load transfer can be written as +\begin{equation} +\label{P2P} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{S} \\ \vec{F}^{D} \\ \vec{M}^{D} \end{matrix} \right\} += + \begin{bmatrix} + I_{\mathit{N_D}} & 0 & 0 & 0 \\ + 0 & I_{\mathit{N_{S}}} & 0 & 0 \\ + 0 & 0 & M_{li}^{D} & 0 \\ + M_{uD}^{D} & M_{uS}^{D} & M_{f}^{D} & M_{li}^{D} \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{S} \\ \vec{F}^{S} \\ \vec{D}^{S} \end{matrix} \right\} +\end{equation} +where $M_{li}^{D}, M_{uS}^{D}, M_{f}^{D} \in \mathbb{R}^{ \mathit{N_{D}},\mathit{N_{S}}}$ are block matrices that indicate the transfer of loads from one source +node to a node on the destination mesh. $M_{uD}^{D} \in \mathbb{R}^{ \mathit{N_{D}},\mathit{N_{D}}}$ is a diagonal matrix that indicates how the destination mesh's displaced position effects the transfer. + + +\subsubsection{Step 4: Distribute Point loads to a Line2 mesh} +Distributing loads from a Point mesh to a Line2 mesh is the inverse of step 2. + +From Equation \ref{Lump} the equation that linearizes the lumping of loads on a destination mesh is +\begin{equation} +\label{LumpD} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{F}^{D} \\ \vec{M}^{D} \end{matrix} \right\} += + \begin{bmatrix} + I_{\mathit{N_D}} & 0 & 0 \\ + 0 & M_{li}^{DL} & 0 \\ + M_{uD}^{DL} & M_{f}^{DL} & M_{li}^{DL} \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{f}^{D} \\ \vec{m}^{D} \end{matrix} \right\} +\end{equation} +where $M_{li}^{DL}, M_{uD}^{DL}, M_{f}^{DL} \in \mathbb{R}^{ \mathit{N_{D}},\mathit{N_{D}}}$ are block matrices that indicate the mapping of the lumped values to distributed values. It follows that the inverse of this equation is +\begin{equation} +\label{InvLumpD} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{f}^{D} \\ \vec{m}^{D} \end{matrix} \right\} += + \begin{bmatrix} + I_{\mathit{N_D}} & 0 & 0 \\ + 0 & \left[ M_{li}^{DL} \right]^{-1} & 0 \\ + -\left[ M_{li}^{DL} \right]^{-1} M_{uD}^{DL} & + -\left[ M_{li}^{DL} \right]^{-1} M_{f}^{DL} \left[ M_{li}^{DL} \right]^{-1} & + \left[ M_{li}^{DL} \right]^{-1} \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{F}^{D} \\ \vec{M}^{D} \end{matrix} \right\} +\end{equation} +The only inverse we need is already formed (stored as an LU decomposition) from the loads transfer, so we need not form it again. + + +\subsubsection{Putting it together} +To form the matrices for loads transfers for the various mappings available, we now need to multiply a few matrices to return the linearization +matrix that converts loads from the source mesh to loads on the line mesh: +\begin{equation} +\label{LinearEqn} + \left\{ \begin{matrix} \vec{f}^{D} \\ \vec{m}^{D} \end{matrix} \right\} += + \begin{bmatrix} + 0 & 0 & M_{li} & 0 \\ + M_{uD} & M_{uS} & M_f & M_{li} + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^S \\ \vec{f}^{D} \\ \vec{m}^{D} \end{matrix} \right\} +\end{equation} + + + + +\begin{itemize} + \item Line2-to-Line2: Perform steps 1, 2, 3, and 4. + \begin{multline} + \left\{ \begin{matrix} \vec{f}^{D} \\ \vec{m}^{D} \end{matrix} \right\} + = + \begin{bmatrix} + 0 & \left[ M_{li}^{DL} \right]^{-1} & 0 \\ + -\left[ M_{li}^{DL} \right]^{-1} M_{uD}^{DL} & + -\left[ M_{li}^{DL} \right]^{-1} M_{f}^{DL} \left[ M_{li}^{DL} \right]^{-1} & + \left[ M_{li}^{DL} \right]^{-1} \\ + \end{bmatrix} + \\ + \begin{bmatrix} + I_{N_D} & 0 & 0 & 0 \\ + 0 & 0 & M_{li}^{D} & 0 \\ + M_{uD}^{D} & M_{uS}^{D} & M_{f}^{D} & M_{li}^{D} \\ + \end{bmatrix} + \begin{bmatrix} + I_{N_D} & 0 & 0 & 0 \\ + 0 & I_{\mathit{N_{SA}}} & 0 & 0 \\ + 0 & 0 & M_{li}^{SL} & 0 \\ + 0 & M_{uS}^{SL} & M_{f}^{SL} & M_{li}^{SL} \\ + \end{bmatrix} + \\ + \begin{bmatrix} + I_{\mathit{N_D}} & 0 & 0 & 0 \\ + 0 & M^A & 0 & 0 \\ + 0 & 0 & M^A & 0 \\ + 0 & 0 & 0 & M^A \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{S} \\ \vec{f}^{S} \\ \vec{m}^{S} \end{matrix} \right\} + \end{multline} + \begin{align} + M_{li} &= \left(M_{li}^{DL}\right)^{-1}M_{li}^D M_{li}^{SL} M_A \\ + M_{uD} &= \left(M_{li}^{DL}\right)^{-1}\left[M_{uD}^D - M_{uD}^{DL}\right] \\ + M_{uS} &= \left(M_{li}^{DL}\right)^{-1} \left[ M_{uS}^D + M_{li}^D M_{uS}^{SL}\right] M_A \\ + M_{f} &= \left(M_{li}^{DL}\right)^{-1}\left( \left[M_{f}^D - M_{f}^{DL}\left(M_{li}^{DL}\right)^{-1}M_{li}^D\right] M_{li}^{SL} + + M_{li}^D M_{f}^{SL} \right)M_A \end{align} + + + \item Line2-to-Point: Perform steps 1, 2, and 3. + \begin{multline} + \left\{ \begin{matrix} \vec{F}^{D} \\ \vec{M}^{D} \end{matrix} \right\} + = + \begin{bmatrix} + 0 & 0 & M_{li}^{D} & 0 \\ + M_{uD}^{D} & M_{uS}^{D} & M_{f}^{D} & M_{li}^{D} \\ + \end{bmatrix} + \begin{bmatrix} + I_{N_D} & 0 & 0 & 0 \\ + 0 & I_{\mathit{N_{SA}}} & 0 & 0 \\ + 0 & 0 & M_{li}^{SL} & 0 \\ + 0 & M_{uS}^{SL} & M_{f}^{SL} & M_{li}^{SL} \\ + \end{bmatrix} + \\ + \begin{bmatrix} + I_{\mathit{N_D}} & 0 & 0 & 0 \\ + 0 & M^A & 0 & 0 \\ + 0 & 0 & M^A & 0 \\ + 0 & 0 & 0 & M^A \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{S} \\ \vec{f}^{S} \\ \vec{m}^{S} \end{matrix} \right\} + \end{multline} + The linearization routine returns these four matrices: + \begin{align} + M_{li} &= M_{li}^D M_{li}^{SL} M_{A} \\ + M_{uD} &= M_{uD}^D \\ + M_{uS} &= \left[ M_{uS}^D + M_{li}^{D} M_{uS}^{SL}\right]M_{A} \\ + M_{f} &= \left[ M_{f}^D M_{li}^{SL} + M_{li}^{D} M_{f}^{SL} \right]M_{A} \end{align} + + + \item Point-to-Line2: Perform steps 3 and 4. + %\begin{equation} + \begin{multline} + \left\{ \begin{matrix} \vec{f}^{D} \\ \vec{m}^{D} \end{matrix} \right\} + = + \begin{bmatrix} + 0 & \left[ M_{li}^{DL} \right]^{-1} & 0 \\ + -\left[ M_{li}^{DL} \right]^{-1} M_{uD}^{DL} & + -\left[ M_{li}^{DL} \right]^{-1} M_{f}^{DL} \left[ M_{li}^{DL} \right]^{-1} & + \left[ M_{li}^{DL} \right]^{-1} \\ + \end{bmatrix} \\ + \begin{bmatrix} + I_{N_D} & 0 & 0 & 0 \\ + 0 & 0 & M_{li}^{D} & 0 \\ + M_{uD}^{D} & M_{uS}^{D} & M_{f}^{D} & M_{li}^{D} \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{S} \\ \vec{F}^{S} \\ \vec{M}^{S} \end{matrix} \right\} + \end{multline} + %\end{equation} + The linearization routine returns these four matrices: + \begin{align} M_{li} &= \left(M_{li}^{DL}\right)^{-1}M_{li}^D \\ + M_{uD} &= \left(M_{li}^{DL}\right)^{-1}\left[M_{uD}^D - M_{uD}^{DL}\right] \\ + M_{uS} &= \left(M_{li}^{DL}\right)^{-1}M_{uS}^D \\ + M_{f} &= \left(M_{li}^{DL}\right)^{-1}\left[M_{f}^D - M_{f}^{DL} M_{li} \right] \end{align} + + + \item Point-to-Point: Perform step 3. + \begin{equation} + \left\{ \begin{matrix} \vec{F}^{D} \\ \vec{M}^{D} \end{matrix} \right\} + = + \begin{bmatrix} + 0 & 0 & M_{li}^{D} & 0 \\ + M_{uD}^{D} & M_{uS}^{D} & M_{f}^{D} & M_{li}^{D} \\ + \end{bmatrix} + \left\{ \begin{matrix} \vec{u}^D \\ \vec{u}^{S} \\ \vec{F}^{S} \\ \vec{M}^{S} \end{matrix} \right\} + \end{equation} + The linearization routine returns these four matrices: + \begin{align} M_{li} &= M_{li}^D \\ + M_{uD} &= M_{uD}^D \\ + M_{uS} &= M_{uS}^D \\ + M_{f} &= M_{f}^D \end{align} + +\end{itemize} + +\end{document} diff --git a/docs/OtherSupporting/OutListParameters.xlsx b/docs/OtherSupporting/OutListParameters.xlsx new file mode 100644 index 0000000000..98bf58db1a Binary files /dev/null and b/docs/OtherSupporting/OutListParameters.xlsx differ diff --git a/docs/_static/css/math_eq.css b/docs/_static/css/math_eq.css new file mode 100644 index 0000000000..ffc5f20ea4 --- /dev/null +++ b/docs/_static/css/math_eq.css @@ -0,0 +1,6 @@ +.math { + text-align: left; +} +.eqno { + float: right; +} diff --git a/docs/conf.py b/docs/conf.py index a2b5f1734f..85bf5c061b 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -245,6 +245,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): ] def setup(app): + app.add_css_file('css/math_eq.css') app.add_object_type( "confval", "confval", @@ -257,3 +258,4 @@ def setup(app): objname="CMake configuration value", indextemplate="pair: %s; CMake configuration" ) + diff --git a/docs/index.rst b/docs/index.rst index c4474e9749..0b5f130b81 100644 --- a/docs/index.rst +++ b/docs/index.rst @@ -42,7 +42,6 @@ package: - `OpenFAST Github Organization `_ - `Github Repository `_ -- `Nightly Tests `_ **Documentation Directory** diff --git a/docs/requirements.txt b/docs/requirements.txt index 927c3444c2..e13cf71021 100644 --- a/docs/requirements.txt +++ b/docs/requirements.txt @@ -1,9 +1,9 @@ -breathe==4.4.0 -docutils==0.13.1 -Pygments==2.2.0 -pyparsing==2.1.9 -Sphinx==1.5.2 -sphinxcontrib-bibtex==0.3.4 -sphinxcontrib-doxylink==1.3 -sphinx_rtd_theme==0.3.1 +breathe>=4.4 +docutils>=0.13 +Pygments>=2.2 +pyparsing>=2.1 +Sphinx>=1.8.5 +sphinxcontrib-bibtex>=0.3.3 +sphinxcontrib-doxylink>=1.3 +sphinx_rtd_theme>=0.3 requests[security] diff --git a/docs/source/dev/index.rst b/docs/source/dev/index.rst index 2725408ae7..81fa6aa01e 100644 --- a/docs/source/dev/index.rst +++ b/docs/source/dev/index.rst @@ -99,3 +99,14 @@ generally debugging and building out features. debugging.rst performance.rst versioning.rst + +Other Documentation +~~~~~~~~~~~~~~~~~~~ +Additional documentation exists that may be useful for developers seeking deeper +understanding of the solver and mathematics. This documentation is not generally +necessary for most development efforts. + +.. toctree:: + :maxdepth: 1 + + other_docs.rst diff --git a/docs/source/dev/other_docs.rst b/docs/source/dev/other_docs.rst new file mode 100644 index 0000000000..e6592f8dfa --- /dev/null +++ b/docs/source/dev/other_docs.rst @@ -0,0 +1,18 @@ +.. _other_docs: + +Other documentation +~~~~~~~~~~~~~~~~~~~ +Additional documentation exists that may be useful for developers seeking deeper +understanding of the solver and mathematics. This documentation is not generally +necessary for most development efforts. + +- :download:`DCM_Interpolation.pdf <../../OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf>` + This is a summary of the mathematics used in the interpolation of + DCM (direction cosine matrices) using logarithmic mapping and matrix exponentials. +- :download:`OpenFAST_Algorithms.pdf <../../OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf>` + This is a summary of the solve method used in the glue code. +- :download:`OutListParameters.xlsx <../../OtherSupporting/OutListParameters.xlsx>` + This Excel file contains the full list of outputs for each module. It is used to generate the + Fortran code for the output channel list handling for each module (this code is generally in + the _IO.f90 files). The MATLAB script available in the + `matlab-toolbox `__ repository at *Utilities/GetOutListParameters.m*. diff --git a/docs/source/install/index.rst b/docs/source/install/index.rst index 9c42a658b7..1e1b5d7677 100644 --- a/docs/source/install/index.rst +++ b/docs/source/install/index.rst @@ -35,6 +35,14 @@ All precompiled binaries can be found in the ``Assets`` dropdown in the `here `__ to download the latest binaries. +Note that the precompiled binaries require either the Intel fortran +compiler or the Intel MKL redistributable libraries, which are not by +default included with the binaries. To configure the libraries, download the +installers from `here `__ +and run the MSI file(s) to install the libraries. Note that if you have a +Command Prompt open, you will need to close it after installing the libraries +in order for the changes to take effect. + Compile from source ~~~~~~~~~~~~~~~~~~~ For compiling from source code, the NREL OpenFAST team has developed an @@ -228,6 +236,7 @@ The CMake options specific to OpenFAST and their default settings are: GENERATE_TYPES - Use the openfast-regsitry to autogenerate types modules ORCA_DLL_LOAD - Enable OrcaFlex library load (Default: OFF) USE_DLL_INTERFACE - Enable runtime loading of dynamic libraries (Default: ON) + OPENMP - Enable OpenMP parallelization in FVW (Default: OFF) Additional system-specific options may exist for a given system, but those should not impact the OpenFAST configuration. As mentioned above, the diff --git a/docs/source/testing/regression_test.rst b/docs/source/testing/regression_test.rst index b9b0fc1e98..8c29e5aa16 100644 --- a/docs/source/testing/regression_test.rst +++ b/docs/source/testing/regression_test.rst @@ -65,7 +65,7 @@ Dependencies ------------ The following packages are required for regression testing: -- Python 3+ +- Python 3.7+ - Numpy - CMake and CTest (Optional) - Bokeh 1.4 (Optional) diff --git a/docs/source/testing/unit_test.rst b/docs/source/testing/unit_test.rst index d2d2bef299..ab24a06fe8 100644 --- a/docs/source/testing/unit_test.rst +++ b/docs/source/testing/unit_test.rst @@ -21,7 +21,7 @@ Dependencies ------------ The following packages are required for unit testing: -- Python 3+ +- Python 3.7+ - CMake - pFUnit - Included in OpenFAST repo through a git-submodule diff --git a/docs/source/user/aerodyn-aeroacoustics/01-introduction.rst b/docs/source/user/aerodyn-aeroacoustics/01-introduction.rst new file mode 100644 index 0000000000..3b33cd5ac8 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/01-introduction.rst @@ -0,0 +1,47 @@ +.. _AA-introduction: + +Introduction +------------ + +The increasing penetration of wind energy into the electricity mix has +been possible thanks to a constantly growing installed capacity, which +has so far been mostly located on land. Land-based installations are, +however, increasingly constrained by local ordinances and an +often-limiting factor that comprises maximum allowable levels of noise. +To further increase the number of land-based installations, it is +important to develop accurate modeling tools to estimate the noise +generated by wind turbines. This allows for a more accurate assessment +of the noise emissions and the possibility to design quieter wind +turbines. + +Wind turbines emit two main sources of noise: + +- Aeroacoustics noise from the interaction between rotor blades and the + turbulent atmospheric boundary layer + +- Mechanical noise from the nacelle component, mostly the gearbox, + generator, and yaw mechanism. + +This work targets the first class of noise generation and aims at +providing a set of open-source models to estimate the aeroacoustics +noise generated by an arbitrary wind turbine rotor. The models are +implemented in Fortran and are fully coupled to the aeroservoelastic +wind turbine simulator OpenFAST. The code is available in the GitHub +repository of OpenFAST. [1]_ The code builds on the implementation of +NAFNoise and the documentation presented in :cite:`aa-MoriartyMigliore:2003` +and :cite:`aa-Moriarty:2005`. OpenFAST is implemented as a modularization +framework and the aeroacoustics model is implemented as a submodule of +AeroDyn (:cite:`aa-MoriartyHansen:2005`). + +The set of models is described in :numref:`AA-noise-models` and exercised on the +noise estimate of the International Energy Agency (IEA) land-based reference +wind turbine in :numref:`AA-model-verification`. In +:numref:`AA-model-verification`, we also show a comparison to results obtained +running the noise models implemented at the Technical University of Munich. This +documentation closes with conclusions, an outlook on future work, and +appendices, where the input files to OpenFAST are presented. + + +.. [1] + https://github.com/OpenFAST/openfast + diff --git a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst new file mode 100644 index 0000000000..b1b13c4696 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst @@ -0,0 +1,576 @@ +.. _AA-noise-models: + +Aeroacoustics Noise Models +-------------------------- + +The aeroacoustics noise of wind turbine rotors emanates from pressure +oscillations that are generated along the blades and propagate in the +atmosphere. This source of noise has been historically simulated with models +characterized by different fidelity levels. At lower fidelity, models correlated +aeroacoustics noise with rotor thrust and torque +(:cite:`aa-Lowson:1970,aa-Viterna:1981`). At higher fidelity, three-dimensional +incompressible computational fluid dynamics models are coupled with the Ffowcs +Williams-Hawkings model to propagate pressure oscillations generated along the +surface of the rotor blades to the far field (:cite:`aa-Klein:2018`). The latter +models are often only suitable to estimate noise at low frequency because +capturing noise in the audible range, which is commonly defined between 20 +(hertz) Hz and 20 kilohertz (kHz), requires a very fine space-time +discretization with enormous computational costs. + +For the audible range, a variety of models is available in the public +domain, and :cite:`aa-Sucameli:2018` offers the most recent literature +review. These models have inputs that match the inputs and outputs of +modern aeroservoelastic solvers, such as OpenFAST, and have therefore +often been coupled together. Further, the computational costs of these +acoustic models are similar to the costs of modern aeroservoelastic +solvers, which has facilitated the coupling. + +Models have targeted different noise generation mechanisms following the +distinction defined by :cite:`aa-Brooks:1989`, and the +mechanism of turbulent inflow noise. The latter represents a broadband +noise source that is generated when a body of arbitrary shape +experiences an unsteady lift because of the presence of an incident +turbulent flow. For an airfoil, this phenomenon can be interpreted as +leading-edge noise. Turbulent inflow noise was the topic of multiple +investigations over the past decades and, as a result, multiple models +have been published (:cite:`aa-Sucameli:2018`). The BPM model includes five +mechanisms of noise generation for an airfoil immersed in a flow: + +1. Turbulent boundary layer – trailing edge (TBL-TE) + +2. Separation stall + +3. Laminar boundary layer – vortex shedding + +4. Tip vortex + +5. Trailing-edge bluntness – vortex shedding. + +For the five mechanisms, semiempirical models were initially defined for +the NACA 0012 airfoil. The BPM model is still a popular model for wind +turbine noise prediction, and subsequent studies have improved the model +by removing some of the assumptions originally adopted. Recent studies +have especially focused on the TBL-TE mechanism, which is commonly the +dominant noise source of modern wind turbines. As a result, each noise +source defined in the BPM model now has a variety of permutations. + +The following subsections describe the details of each mechanism and the +models implemented in this model of OpenFAST. + +.. _aa-turbinflow: + +Turbulent Inflow +~~~~~~~~~~~~~~~~ + +A body of any arbitrary shape, when immersed in a turbulent flow, +generates surface pressure fluctuations. Over the years, several +formulations of the turbulent inflow noise model have been developed +(:cite:`aa-Sucameli:2018`). In this model of OpenFAST, the formulation +defined in :cite:`aa-MoriartyGuidatiMigliore:2004` is adopted. The formulation is based +on the model of Amiet (:cite:`aa-Amiet:1975,aa-Paterson:1976`) and is +presented in :numref:`aa-amiet`. Additionally, the user can activate the +correction defined by :cite:`aa-MoriartyHansen:2005`, which builds upon the +Amiet model and accounts for the thickness of the airfoils adopted along +the blade span. This second model is named Simplified Guidati and is +presented in :numref:`aa-guidati`. + +.. _aa-amiet: + +Amiet model +^^^^^^^^^^^ + +The formulation is based on work from :cite:`aa-Amiet:1975` and +:cite:`aa-Paterson:1976`, and it represents the blade as a +flat plate and neglects the shape of the airfoil. + +The model starts by first computing the wave number, :math:`k_{1}`, for +a given frequency :math:`f`: + +.. math:: + k_{1} = \frac{2\text{πf}}{U_{1}} + :label: aa-eq:1 + +where :math:`U_{1}` is the incident inflow velocity on the profile. From +:math:`k_{1}`, the wave numbers :math:`{\overline{k}}_{1}` and +:math:`{\widehat{k}}_{1}` are computed: + +.. math:: + {\overline{k}}_{1} = \frac{k_{1}c_{i}}{2} + :label: aa-eq:2 + +.. math:: + {\widehat{k}}_{1} = \frac{k_{1}}{k_{e}} + :label: aa-eq:3 + +where :math:`c_{i}` is the local chord, and :math:`k_{e}` is the wave +number range of energy containing eddies, defined as: + +.. math:: + k_{e} = \frac{3}{4L_{t}}. + :label: aa-eq:4 + +L\ :sub:`t` is the turbulent length scale, and many different +formulations have been proposed over the years. As default +implementation, :math:`L_{t}` is defined following the formulation +proposed in :cite:`aa-Zhu:2005`: + +.. math:: + L_{t} = 25z^{0.35}z_{0}^{- 0.063} + :label: aa-eq:5 + +where :math:`z` is the height above the ground of the leading edge of +section :math:`i` at a given instant, :math:`t`, while :math:`z_{0}` is +the surface roughness. Note that setting :math:`L_{t}` appropriately is +a challenge, and advanced users of this model may want to validate this +formulation against experimental data. + +The value of sound pressure level (:math:`\text{SPL}`) is expressed in +one-third octave bands at the given frequency, :math:`f`, originated at +the given blade station, :math:`i`, which can be computed as: + +.. math:: + \text{SPL}_{\text{TI}} = 10\log_{10}{\left( \rho^{2}c^{4}\frac{L_{t}d}{{2r}_{e}^{2}}M^{5}I_{1}^{2} + \frac{{\widehat{k}}_{1}^{3}}{\left( 1 + {\widehat{k}}_{1}^{2} \right)^{\frac{7}{3}}} + \overline{D} \right) +}78.4 + :label: aa-eq:6 + +where :math:`\rho` is the air density, :math:`c` the speed of sound, +:math:`d` the blade element span, :math:`r_{e}` the effective distance +between leading edge and observer, :math:`M` the Mach number, +:math:`I_{1}` the turbulence intensity of the airfoil inflow, and +:math:`\overline{D}` the directivity term. :math:`\overline{D}` is +different below (:math:`{\overline{D}}_{l}`) and above +(:math:`{\overline{D}}_{h}`) a certain frequency, which is named +“cut-off” and defined as: + +.. math:: + f_{\text{co}} = \frac{10U_{1}}{\pi c_{i}}. + :label: aa-eq:7 + +The formulations of :math:`{\overline{D}}_{h}\ `\ and +:math:`{\overline{D}}_{l}` are presented in :numref:`aa-directivity`. + +The current implementation offers two approaches to estimate +:math:`I_{1}`. The first one is through a user-defined grid of +:math:`I_{1}`; see :numref:`aa-sec-TIgrid`. The second option is to have the code +reconstructing :math:`I_{1}` from the turbulent wind grid, where the +code computes the airfoil relative position of each blade section, +:math:`i`, at every time instant and, given the rotor speed, +reconstructs the inflow component, :math:`I_{1}`, of the turbulence +intensity. + +Two corrections to this model are also implemented. The first one +comprises a correction for the angle of attack, :math:`\alpha`, in which +the effect is neglected in the original formulation from :cite:`aa-Amiet:1975` +and Amiet and Peterson (1976). This correction is formulated as: + +.. math:: + \text{SPL}_{\text{TI}} = \text{SPL}_{\text{TI}} + 10\log_{10}{\left( 1 + 9a^{2} \right).} + :label: aa-eq:8 + +The second correction is called low-frequency correction +(:math:`\text{LFC}`), and is formulated as: + +.. math:: + S^{2} = \left( \frac{2\pi{\overline{k}}_{1}}{\beta^{2}} + + \left( 1 + 2.4\frac{{\overline{k}}_{1}}{\beta^{2}} \right)^{- 1} \right)^{- 1} + :label: aa-eq:9 +.. math:: + LFC = 10S^{2}M{\overline{k}}_{1}^{2}\beta^{- 2} + :label: aa-eq:10 +.. math:: + \text{SPL}_{\text{TI}} = \text{SPL}_{\text{TI}} + 10\log_{10}\left( \frac{\text{LFC}}{1 + LFC} \right). + :label: aa-eq:11 + +In :eq:`aa-eq:9` and :eq:`aa-eq:10`, :math:`S^{2}` represents the squared Sears +function, and :math:`\beta^{2}` is the Prandtl-Glauert correction +factor, which is defined as: + +.. math:: + \beta^{2} = 1 - M^{2}. + :label: aa-eq:12 + +It is worth stressing that numerous alternative formulations of the +turbulent inflow noise model exist (:cite:`aa-Sucameli:2018`), where the +main differences comprise different definitions of :math:`L_{t}` and +:math:`k_{1}`. + +.. _aa-guidati: + +Simplified Guidati +^^^^^^^^^^^^^^^^^^ + +Sound spectra are often overpredicted by the Amiet model implemented here. +Guidatai (:cite:`aa-Guidati:1997`) derived a correction to the sound pressure +levels by adding a term considering shape and camber of the airfoil profiles, +but the method proved computationally too expensive for wind turbine +simulations. Moriarty et al. (:cite:`aa-MoriartyGuidatiMigliore:2005`) proposed +a simplified model based on geometric characteristics of six wind turbine +airfoils. The validity of the correction is limited to Mach numbers on the order +of 0.1 ≈ 0.2 and Strouhal number :math:`\text{St}` below 75. :math:`\text{St}` +is defined based on airfoil chord and mean inflow velocity: + +.. math:: + St = \frac{fc_{i}}{U_{1}}. + :label: aa-eq:13 + +The formula for the correction to the noise spectra is provided in Eq. 4 +in :cite:`aa-MoriartyGuidatiMigliore:2005`: + +.. math:: + t = t_{1\%} + t_{10\%} + :label: aa-eq:14 +.. math:: + {\mathrm{\Delta}SPL}_{\text{TI}} = -\left( 1.123t + 5.317t^{2} \right)\left( 2\pi St + 5 \right) + :label: aa-eq:15 + +where :math:`t_{x\%}` is the relative thickness of the profile at +:math:`x` position along the chord (i.e., 0% being the leading edge and +100% the trailing edge). + +It should be highlighted here that a validation campaign was conducted in a wind +tunnel on two-dimensional airfoils (:cite:`aa-MoriartyGuidatiMigliore:2004`), +returning a fairly poor match between the Simplified Guidati model and the +experimental results. Therefore, a correction of +10 decibels (dB) on the SPL +levels across the whole frequency spectrum was proposed. This correction is +still implemented, but a validation at turbine level should assess the accuracy +of the models for turbulent inflow. It should also be noted that the code +currently does not check whether Mach and Strouhal numbers are within the range +of validity of this model. + +.. _aa-turb-TE: + +Turbulent Boundary Layer – Trailing Edge +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Airfoils immersed in a flow develop a boundary layer, which at high +Reynolds numbers is turbulent. When the turbulence passes over the +trailing edge, noise is generated. This noise source was named TBL-TE in +:cite:`aa-Brooks:1989` and it is a relevant source of aeroacoustics noise +for modern wind turbine rotors. Two formulations of TBL-TE noise are +implemented in the code: (1) the original formulation from the BPM +model, described in :numref:`aa-amiet`, and (2) a more recent model developed +at the Dutch research institute, TNO, described in :numref:`aa-guidati`. Both +models take as input the characteristics of the airfoil boundary layer. +These must be provided by the user and are discussed in :numref:`aa-sec-BLinputs`. + +.. _aa-turb-TE-bpm: + +BPM +^^^ + +The :math:`\text{SPL}` of the TBL-TE noise in the BPM model is made from +three contributions: + +.. math:: + \text{SPL}_{TBL - TE} = 10\log_{10}\left( 10^{\frac{\text{SPL}_{p}}{10}} + + 10^{\frac{\text{SPL}_{s}}{10}} + 10^{\frac{\text{SPL}_{\alpha}}{10}} \right) + :label: aa-eq:16 + +where the subscripts :sub:`p`, :sub:`s`, and :sub:`α` refer to the +contributions of pressure side, suction side, and angle of attack, +respectively. The equations describing the three contributions are +described in great detail in Section 5.1.2, in :cite:`aa-Brooks:1989`, and +are summarized here. + +For the suction and pressure contributions, the equations are: + +.. math:: + \text{SPL}_{p} = 10\log_{10}\left( \frac{\delta_{p}^{*}M^{5}d{\overline{D}}_{h}}{r_{e}^{2}} \right) + + A\left( \frac{\text{St}_{p}}{\text{St}_{1}}\right) + \left( K_{1} - 3 \right) + {\mathrm{\Delta}K}_{1} + :label: aa-eq:17 +.. math:: + \text{SPL}_{s} = 10\log_{10}\left( \frac{\delta_{s}^{*}M^{5}d{\overline{D}}_{h}}{r_{e}^{2}} \right) + + A\left( \frac{\text{St}_{s}}{\text{St}_{1}} \right) + \left( K_{1} - 3 \right). + :label: aa-eq:18 + +The terms in the equations, which are also described in the nomenclature +at the beginning of this document, list :math:`\delta^{*}` as the +boundary layer displacement thickness on either side of the airfoil, +:math:`St,` as the Strouhal number based on :math:`\delta^{*}`, and +:math:`A`, :math:`A'`, :math:`B`, :math:`{\Delta K}_{1}`, :math:`K_{1}`, +and :math:`K_{2}` as empirical functions based on :math:`\text{St}`. + +For the angle-of-attack contribution, a distinction is made above and +below the stall angle, which in the original BPM model is set equal to +12.5 degrees, whereas it is here assumed to be the actual stall angle of +attack of the airfoil at blade station i. Below stall, +:math:`\text{SPL}_{\alpha}` is equal to: + +.. math:: + \text{SPL}_{\alpha} = 10\log_{10}\left( \frac{\delta_{s}^{*}M^{5}d{\overline{D}}_{h}}{r_{e}^{2}} \right) + + B\left( \frac{\text{St}_{s}}{\text{St}_{2}} \right) + K_{2}. + :label: aa-eq:19 + +At angles of attack above the stall point, the flow along the profile is +fully separated and noise radiates from the whole +chord.\ :math:`\ \text{SPL}_{p}` and :math:`\text{SPL}_{s}` are then set +equal to -∞, whereas :math:`\text{SPL}_{\alpha}` becomes: + +.. math:: + \text{SPL}_{\alpha} = 10\log_{10}\left( \frac{\delta_{s}^{*}M^{5}d{\overline{D}}_{l}}{r_{e}^{2}} \right) + + A'\left( \frac{\text{St}_{s}}{\text{St}_{2}} \right) + K_{2.} + :label: aa-eq:20 + +Notably, above stall the low-frequency directivity :math:`{\overline{D}}_{l}` is adopted in Eqs. 18 and 19 (see +:numref:`aa-directivity`). + +.. _aa-turb-TE-tno: + +TNO model +^^^^^^^^^ + +The TNO model is a more recent model to simulate the noise emitted by +the vortices shed at the trailing edge of the blades and was formulated +by Parchen (:cite:`aa-Parchen:1998`). The implementation adopted here is the one described +in Moriarty et al. (2005). The TNO model uses the spectrum of the wave +number, :math:`\overline{k}`, of unsteady surface pressures to estimate +the far-field noise. The spectrum, :math:`P`, is assumed to be: + +.. math:: + P\left( k_{1},k_{3},\omega \right) = 4\rho_{0}^{2}\frac{k_{1}^{2}}{k_{1}^{2} + + k_{3}^{2}}\int_{0}^{10\frac{\omega}{Mc}}{L_{2}\overline{u_{2}^{2}} + \left( \frac{\partial U_{1}}{\partial x_{2}} \right)^{2} + \phi_{22}\left( k_{1},k_{3},\omega \right)} \\ + \phi_{m}\left( \omega - U_{c}\left( x_{2} \right)k_{1} \right) + e^{\left( - 2\left| \overline{k} \right|x_{2} \right)}dx_{2}. + :label: aa-eq:21 + +In the equation, the indices 1, 2, and 3 refer to the directions +parallel to the airfoil chord, normal to the airfoil chord, and along +span, respectively; :math:`\phi_{22}` is the vertical velocity +fluctuation spectrum; :math:`\phi_{m}` is the moving axis spectrum; and +:math:`U_{c}` is the convection velocity of the eddies along the +trailing edge. Lastly, :math:`L_{2}` is the vertical correlation length, +perpendicular to the chord length, which indicates the vertical +extension of the vortices that convect over the trailing edge. In this +work, :math:`L_{2}` is assumed equal to the mixing length, :math:`L_{m}` +(Moriarty et al. 2005). This decision is partially arbitrary, and +dedicated research should better assess the correct integral length to +be adopted within the TNO model. + +From :math:`P`, the far-field spectrum, :math:`S\left( \omega \right)`, +is computed as: + +.. math:: + S\left( \omega \right) = \frac{d{\overline{D}}_{h}}{4\pi r_{e}^{2}}\int_{0}^{\delta} + {\frac{\omega}{ck_{1}}P\left( k_{1},0,\omega \right)}\text{dk}_{1}. + :label: aa-eq:22 + +The implementation of the TNO model is identical to the one described in +:cite:`aa-MoriartyGuidatiMigliore:2005`. The inputs to the model are generated from the +boundary layer characteristics provided by the user (see :numref:`aa-sec-BLinputs`). + +.. _aa-laminar-vortex: + +Laminar Boundary Layer – Vortex Shedding +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Another source of airfoil self-noise noise included in the BPM model is +the noise generated by a feedback loop between vortices being shed at +the trailing edge and instability waves in the laminar boundary layer. +This noise is typically distributed on a narrow band of frequencies and +occurs when the boundary layer of the airfoil remains laminar. This may +occur in the inboard region of smaller wind turbines, where the Reynolds +number can be smaller than 1 million, but hardly occurs in modern rotors +that operate at a Reynolds number one order of magnitude larger. The +formula to estimate the noise spectrum in a one-third-octave +presentation is: + +.. math:: + \text{SPL}_{LBL - VS} = 10\log_{10}{ + \left( \frac{\delta_{p}M^{5}d{\overline{D}}_{h}}{r_{e}^{2}} \right) + + G_{1}\left( \frac{St'}{{St'}_{\text{peak}}} \right) \\ + + G_{2}\left\lbrack \frac{\text{Re}_{c}}{\left( \text{Re}_{c} \right)_{0}} \right\rbrack + + G_{3}\left( \alpha_{*} \right)} + :label: aa-eq:23 + +where :math:`G` represents empirical functions, +:math:`{St'}_{\text{peak}}` is the peak Strouhal number function of +:math:`\text{Re}_{c}`, which is the Reynolds number at chord, +:math:`c_{i}`. The subscript :sub:`0` refers to a reference Reynolds +number that is a function of the angle of attack (Brooks et al. 1989). + +.. _aa-tip-vortex: + +Tip Vortex +~~~~~~~~~~ + +The vortices generated at blade tips are another source of noise of the +BPM model. Although rarely relevant in modern wind turbines, the +possibility to include this noise source is offered. The sound pressure +level is estimated as: + +.. math:: + \text{SPL}_{\text{Tip}} = 10\log_{10}{\left( + \frac{M^{2}M_{\max}^{2}l^{2}{\overline{D}}_{h}}{r_{e}^{2}} \right) + - 30.5\left( \log_{10}{St^{''}} + 0.3 \right)^{2} + 126} + :label: aa-eq:24 + +where :math:`M_{\max}\ = \ M_{\max}\left( \alpha_{\text{tip}} \right)` +is the maximum Mach number, measured near the blade tip within the +separated flow region that is assumed to depend on +:math:`\alpha_{\text{tip}}`, which is the angle of attack at the tip; +:math:`l` is the spanwise extent of the separation zone; and +:math:`St'''` is the Strouhal number based on :math:`l`. For a round +shape of the tip, :math:`l` is estimated as: + +.. math:: + l = c_{i}0.008\alpha_{\text{tip}} + :label: aa-eq:25 + +where :math:`\alpha_{\text{tip}}` is the angle of attack of the tip +region to the incoming flow. For a square tip, the BPM model estimates +:math:`l` based on the quantity, :math:`{\alpha'}_{\text{tip}}`, which +is defined as: + +.. math:: + \left. \ {\alpha^{'}}_{\text{tip}} = \left\lbrack \left( + \frac{\frac{\partial L'}{\partial y}}{\left( + \frac{\partial L'}{\partial y} \right)_{\text{ref}}} + \right)_{y\rightarrow tip} + \right\rbrack \right.\ \alpha_{\text{tip}} + :label: aa-eq:26 + +where :math:`L'` is the lift per unit span along the blade at position +:math:`y`. For :math:`{\alpha'}_{\text{tip}}` between 0 and 2 degrees, +:math:`l` becomes: + +.. math:: + l = c_{i}\left( 0.0230 + 0.0169{\alpha^{'}}_{\text{tip}} \right), + :label: aa-eq:27 + +while for :math:`{\alpha'}_{\text{tip}}` larger than 2 degrees, +:math:`l` is: + +.. math:: + l = c_{i}\left( 0.0378 + 0.0095{\alpha^{'}}_{\text{tip}} \right). + :label: aa-eq:28 + +However, it must be noted that, unfortunately, +:math:`\alpha_{\text{tip}}` is not a reliable output of standard +aeroelastic models and the impossibility to accurately determine +:math:`\alpha_{\text{tip}}` weakens the formulation of the tip vortex +noise. + +.. _aa-TE-vortex: + +Trailing-Edge Bluntness – Vortex Shedding +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Lastly, wind turbine blades are often characterized by a finite height of the +trailing edge, which generates noise as a result of vortex shedding. The +frequency and amplitude of this noise source depends on the geometry of the +trailing edge and is typically characterized by a tonal nature. Adopting +flatback and truncated airfoils far outboard along the blade may strengthen this +noise source. When this noise source is activated, the user is asked to provide +the distribution along the blade span of the blunt thickness of the trailing +edge, :math:`h`, and the solid angle between the suction and pressure sides of +the airfoil, :math:`\Psi` (see :numref:`aa-sec-TEgeom`). :math:`h` and +:math:`\Psi` are inputs to the equation: + +.. math:: + \text{SPL}_{TEB - VS} = 10\log_{10}{ + \left( \frac{\delta_{p}^{*}M^{5}d{\overline{D}}_{h}}{r_{e}^{2}} \right) + + G_{4}\left( \frac{h}{\delta_{\text{avg}}^{*}},\Psi \right) \\ + + G_{5}\left( \frac{h}{\delta_{\text{avg}}^{*}},\Psi, + \frac{St''}{{St''}_{\text{peak}}} \right)}. + :label: aa-eq:29 + +In the equation, :math:`\delta_{\text{avg}}^{*}` is the average +displacement thickness for both sides of the airfoil. Note that this +noise source is very sensitive to :math:`h` and :math:`\Psi`, which, +therefore, should be estimated accurately. + +.. _aa-directivity: + +Directivity +~~~~~~~~~~~ + +The position of one or more observers is specified by the user, as described in +:numref:`aa-sec-ObsPos`. The directivity from the BPM model is adopted in this +implementation (:cite:`aa-Brooks:1989`). The directivity term, +:math:`\overline{D}`, corrects the :math:`\text{SPL}` depending on the relative +position of the observer to the emitter. The position is described by the +spanwise directivity angle, :math:`\Phi_{e}`, and by the chordwise directivity +angle, :math:`\Theta_{e}`, which are schematically represented in +:numref:`aa-fig:directivity` and defined as: + +.. math:: + \Phi_{e} = \text{atan}\left( \frac{z_{e}}{y_{e}} \right) + :label: aa-eq:30 +.. math:: + \Theta_{e} = \text{atan}\left( \frac{y_{e} \bullet \cos\left( \Phi_{e} \right) + + z_{e} \bullet \sin\left( \Phi_{e} \right)}{x_{e}} \right) + :label: aa-eq:31 + + +.. figure:: media/NoiseN002.jpeg + :alt: Angles used in the directivity function + :name: aa-fig:directivity + :width: 100.0% + + Angles used in the directivity function (:cite:`aa-Brooks:1989,aa-MoriartyMigliore:2003`) + +The reference axis is located at each blade node and :math:`x_{e}` is aligned +with the chord, :math:`y_{e}` is aligned with the span pointing to the blade +tip, and :math:`z_{e}` is aligned toward the airfoil suction side. Note that in +OpenFAST the local airfoil-oriented reference system is used, and a rotation is +applied. + +Given the angles :math:`\Theta_{e}` and :math:`\Phi_{e}`, at high frequency, +:math:`\overline{D}` takes the expression: + +.. math:: + {\overline{D}}_{h}\left( \Theta_{e},\Phi_{e} \right) = \frac{ + 2\sin^{2}\left( \frac{\Theta_{e}}{2} \right)\sin^{2}\Phi_{e}} + {\left( 1 + M\cos\Theta_{e} \right) + \left( 1 + \left( M - M_{c} \right) + \cos\Theta_{e} \right)^{2}} + :label: aa-eq:32 + +where :math:`M_{c}` represents the Mach number past the trailing edge +and that is here for simplicity assumed equal to 80% of free-stream M. At low +frequency, the equation becomes: + +.. math:: + {\overline{D}}_{l}\left( \Theta_{e},\Phi_{e} \right) = + \frac{\sin^{2}\left. \ \Theta_{e} \right.\ \sin^{2}\Phi_{e}} + {\left( 1 + M\cos\Theta_{e} \right)^{4}}. + :label: aa-eq:33 + +Each model distinguishes a different value between low and high +frequency. For the TI noise model, the shift between low and high +frequency is defined based on :math:`{\overline{k}}_{1}`. For the TBL-TE +noise, the model differences instead shift between below and above +stall, where\ :math:`\ {\overline{D}}_{h}`\ and +:math:`{\overline{D}}_{l}` are used, respectively. + +.. _aa-A-weighting: + +A-Weighting +~~~~~~~~~~~ + +The code offers the possibility to weigh the aeroacoustics outputs by +A-weighting, which is an experimental coefficient that aims to take into +account the sensitivity of human hearing to different frequencies. +The A-weight, :math:`A_{w}`, is computed as: + +.. math:: + A_{w} = \frac{10\log\left( 1.562339\frac{f^{4}} + {\left( f^{2} + {107.65265}^{2} \right) + \left( f^{2} + {737.86223}^{2} \right)} + \right)}{\log 10}\qquad\qquad\\ + + \frac{10\log\left( 2.422881e16\frac{f^{4}} + {\left( f^{2} + {20.598997}^{2} \right)^{2} + \left( f^{2} + {12194.22}^{2} \right)^{2}} \right)} + {\log 10} + :label: aa-eq:34 + +The A-weighting is a function of frequency and is added to the values of +sound pressure levels: + +.. math:: + SPL_{A_{w}} = SPL + A_{w} + :label: aa-eq:35 + diff --git a/docs/source/user/aerodyn-aeroacoustics/03-model-verification.rst b/docs/source/user/aerodyn-aeroacoustics/03-model-verification.rst new file mode 100644 index 0000000000..6a3c13712c --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/03-model-verification.rst @@ -0,0 +1,230 @@ +.. _AA-model-verification: + + +Model Verification +------------------ + +Reference Wind Turbine +~~~~~~~~~~~~~~~~~~~~~~ + +The noise model of OpenFAST is exercised by simulating the aeroacoustics noise +emissions of the IEA Wind Task 37 land-based reference wind turbine +(:cite:`aa-Bortolotti:2019`). The main characteristics of the reference wind +turbine are presented in :numref:`tab:ref-turb`. + +.. table:: Main Characteristics of the IEA Wind Task 37 Land-Based Reference Wind Turbine + :name: tab:ref-turb + + +------------------+---------------------+------------------+-------------------+ + | **Data** | **Value** | **Data** | **Value** | + +==================+=====================+==================+===================+ + | Wind class | | International | | Rated | 3.37 megawatts | + | | | Electrotechnical | electrical | | + | | | Commision 3A | | power | | + +------------------+---------------------+------------------+-------------------+ + | | Rated | 3.6 megawatts | | Drivetrain & | 93.60% | + | aerodynamic | | | generator | | + | | power | | efficiency | | + +------------------+---------------------+------------------+-------------------+ + | Rotor diameter | 130 meters | Hub height | 110 meters | + +------------------+---------------------+------------------+-------------------+ + | Cut-in wind | 4 | Cut-out wind | 25 | + | speed | meters/second | speed | meters/second | + +------------------+---------------------+------------------+-------------------+ + | Rotor cone | 3 degrees | Nacelle tilt | 5 degrees | + | angle | | angle | | + +------------------+---------------------+------------------+-------------------+ + | Max blade tip | 80 | | Rated | 8.16 | + | speed | meters/second | tip-speed | | + | | | | ratio | | + +------------------+---------------------+------------------+-------------------+ + | | Maximum | 0.481 | Rated rotor | | 11.75 | + | | aerodynamic Cp | | speed | revolutions per | + | | | | | minute | + +------------------+---------------------+------------------+-------------------+ + +The OpenFAST model of the wind turbine is available at +https://github.com/OpenFAST/r-test and is optionally coupled to the +Reference OpenSource Controller. [2]_ + +Code-to-Code Comparison +~~~~~~~~~~~~~~~~~~~~~~~ + +A detailed code-to-code comparison was conducted to verify the implementation of +the noise models linked to OpenFAST with the implementation available at the +Wind Energy Institute of the Technical University of Munich, Germany. The latter +is described in Sucameli (:cite:`aa-Sucameli:2018`) and is implemented in the wind +turbine design framework Cp-Max, which adopts the multibody-based +aeroservoelastic solver Cp-Lambda. + +The comparison is conducted for the main noise sources—turbulent inflow and the +TBL-TE noise—for both the single airfoil profile and full turbine. This helped +resolve a few implementation mistakes and small inconsistencies. The comparison +is performed with a steady wind of 8 meters per second (m/s), no shear, a rated +pitch angle of 1.17 degrees (deg), and a fixed rotor speed of 10.04 revolutions +per minute (rpm). A fixed value of 0.1 is assumed for the incident turbulent +intensity, :math:`I_{1}`. + +:numref:`aa-fig:TI-compare` shows the predictions in terms of SPL for the Amiet +model with the angle-of-attack correction from OpenFAST, the Simplified Guidati +model generated by OpenFAST, and the Amiet model from Cp-Max. + +.. figure:: media/NoiseN003.png + :alt: Code-to-code comparison for the TI models + :name: aa-fig:TI-compare + :width: 100.0% + + Code-to-code comparison for the TI models + + +The two implementations of the turbulent inflow Amiet model return a perfect +match between OpenFAST and Cp-Max. The chosen scenario sees the blade operating +at optimal angles of attack and, therefore, the effect of the angle of attack +correction is negligible. The plots also show the great difference between the +Amiet model and the Simplified Guidati model. It may be useful to keep in mind +that the Simplified Guidati model has, in the past, been corrected with a factor +of +10 dB, which is applied here. + +For the same inflow and rotor conditions, the BPM and TNO TBL-TE noise models +are compared in :numref:`aa-fig:BPM-TNO-compare`. The match is again satisfactory, +although slightly larger differences emerge that are attributed to differences +in the angles of attack between the two aeroelastic solvers and in different +integration schemes in the TNO formulations. + +.. figure:: media/NoiseN004.png + :alt: Code-to-code comparison for the BPM and TNO TBL-TE models + :name: aa-fig:BPM-TNO-compare + :width: 100.0% + + Code-to-code comparison for the BPM and TNO TBL-TE models. The + boundary layer properties are estimated from either the BPM model (BPM + BL) or defined by the user (Ext BL) + + +The last comparison looked at the directivity models and the overall sound +pressure levels at various observer locations. Simulations are run distributing +200 observers in a horizontal square of 500 meters (m) by 500 m (see +:numref:`aa-fig:obs-loc`). The noise is computed from the Amiet and the BPM turbulent boundary layer-trailing edge models. +The code-to-code comparison returns similar predictions +between OpenFAST and Cp-Max. The comparison is shown in :numref:`aa-fig:SPL-obs`. + +The main conclusion of this code-to-code comparison is that, to the best of +authors’ knowledge, the models are now implemented correctly and generate +similar SPL and overall SPL levels for any arbitrary observer. Nonetheless, it +is clear that all of the presented models are imperfect, and improvements could +be made both at the theoretical implementation levels. + +.. figure:: media/NoiseN005.png + :alt: Location and numbering of the observers + :name: aa-fig:obs-loc + :width: 100.0% + + Location and numbering of the observers + +.. figure:: media/NoiseN006.png + :alt: Comparison of overall sound pressure levels for the observers + :name: aa-fig:SPL-obs + :width: 100.0% + + Comparison of overall sound pressure levels for the observers + distributed, as shown in the previous figure + + +.. _aa-sec-ModelUsage: + +Model Usage +~~~~~~~~~~~ + +The aeroacoustics model of OpenFAST has four options for the outputs: + +1. Overall sound pressure level (dB/A-weighted decibels [dBA])—one value + per time step per observer is generated + +2. Total sound pressure level spectra (dB/dBA)—one spectrum per time + step per observer is generated between 10 Hz and 20 kHz + +3. Mechanism-dependent sound pressure level spectra (dB/dBA)—one + spectrum per active noise mechanism per time step per observer is + generated between 10 Hz and 20 kHz. + +4. Overall sound pressure level (dB/A-weighted decibels [dBA])—one value per blade per node per time step per observer is generated + +The overall SPL from the first option can be used to plot directivity maps of the noise. An example, +which was generated using a Python script, [3]_ is shown in +:numref:`aa-fig:SPL-map`. The noise map, which shows the overall SPL averaged over +1 rotor revolution, is generated for a steady wind speed of 8 m/s, a fixed rotor +speed of 10.04 rpm, and a 1.17-deg pitch angle. In a horizontal circle of 500 m +in diameter, 1681 observers are placed at a 2-m height. Only the Simplified +Guidati and the BPM TBL-TE noise models are activated. + +.. figure:: media/NoiseN007.png + :alt: Map of the overall SPL of the reference wind turbine + :name: aa-fig:SPL-map + :width: 100.0% + + Map of the overall SPL of the reference wind turbine at a 2-m height from + Simplified Guidati and BPM TBL-TE noise models. The wind turbine is located + at x=0, y=0. A steady wind of 8 m/s blows from left (-x) to right (+x). + +The second output can be used to generate SPL spectra. These spectra can be +computed for various observers and optionally A-weighted to account for human +hearing. :numref:`aa-fig:A-SPL` shows the total SPL spectra computed for the same +rotor conditions of the previous example. The A-weight greatly reduces the curve +at frequency below 1,000 Hz while slightly increasing those between 1 kHz and 8 +kHz. + +.. figure:: media/NoiseN008.png + :alt: Comparison between absolute and A-weighted SPL + :name: aa-fig:A-SPL + :width: 100.0% + + Comparison between absolute and A-weighted SPL + +The third output distinguishes the SPL spectrum per mechanism. +:numref:`aa-fig:SPL-spectra` shows the various SPL spectra estimated by each noise +model for the same rotor conditions reported earlier. The total spectrum is +visibly dominated by the turbulent inflow, TBL-TE, and trailing-edge bluntness +noise mechanisms. Notably, the latter is extremely sensitive to its inputs, +:math:`\Psi` and :math:`h`. The reference wind turbine is a purely numerical +model, and these quantities have been arbitrarily set. Users should pay +attention to these inputs when calling the trailing-edge bluntness model. +Consistent with literature, the laminar boundary layer-vortex shedding and tip +vortex noise mechanisms have negative dB values and are, therefore, not visible. +Notably, these spectra are not A-weighted, but users can activate the flag and +obtain A-weighted spectra. + +.. figure:: media/NoiseN009.png + :alt: Nonweighted SPL spectra of the various noise mechanisms + :name: aa-fig:SPL-spectra + :width: 100.0% + + Nonweighted SPL spectra of the various noise mechanisms + +Finally, the fourth output can be used to visualize the noise emission across the rotor. +:numref:`aa-fig:rotor-map` shows the noise generation of the rotor as seen from an observer located 175 meters +downwind at a height of 2 meters. The map is generated by plotting the overall SPL generated +by one blade during one rotor revolution. The plot shows that higher noise is observed +when the blade is descending (the rotor from behind is seen rotating counterclockwise). +This effect, which matches the results shown in :cite:`aa-MoriartyMigliore:2003`, +is explained by the asymmetry of :eq:`aa-eq:31`. Noise is indeed higher when the observer +faces the leading edge of an airfoil (high :math:`\Theta_e`), than when it faces the +trailing edge (low :math:`\Theta_e`). + +.. figure:: media/NoiseN012.png + :alt: Map of the overall SPL of the rotor of the reference wind turbine from Simplified Guidati and BPM TBL-TE noise models. The observer is located 175 meters downwind at a height of 2 meters. + :name: aa-fig:rotor-map + :width: 100.0% + + Map of the overall SPL of the rotor of the reference wind turbine + from Simplified Guidati and BPM TBL-TE noise models. The observer + is located 175 meters downwind at a height of 2 meters. + + + +.. [2] + https://github.com/NREL/ROSCO + +.. [3] + https://github.com/OpenFAST/python-toolbox + + diff --git a/docs/source/user/aerodyn-aeroacoustics/04-conclusions.rst b/docs/source/user/aerodyn-aeroacoustics/04-conclusions.rst new file mode 100644 index 0000000000..ba061e8e33 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/04-conclusions.rst @@ -0,0 +1,22 @@ +.. _AA-conclusions: + +Conclusions +----------- + +This document describes a set of frequency-based aeroacoustics models coupled to +the open-source aeroservoelastic solver OpenFAST. The goal of these models is to +predict the aeroacoustics emissions of wind turbine rotors. The document shows a +code-to-code comparison between the models coupled to OpenFAST and the models +implemented at the Technical University of Munich and coupled to the +aeroservoelastic solver Cp-Lambda. The comparison is performed simulating the +aeroacoustics emissions of the IEA Wind Task 37 land-based reference wind +turbine. The results show a good agreement between the two implementations. The +same turbine model is later used to exercise the aeroacoustics model showcasing +its capabilities. Finally, the appendices describe the entries of the input +files of OpenFAST to run the aeroacoustics analysis. + +Future work will focus on the validation of the aeroacoustics models. +In parallel, propagation models will be investigated and implemented. +Finally, attention will be dedicated to infrasound noise and to the +time-domain models that can simulate it. + diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst new file mode 100644 index 0000000000..fb36ee7c22 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -0,0 +1,301 @@ +.. _AA-usage: + +Using the Aeroacoustics Model in AeroDyn +======================================== + +A live version of this documentation is available at +https://openfast.readthedocs.io/. To run the aeroacoustics model, the +flag **CompAA** needs to be set to **True** at line 13 of the AeroDyn15 main +input file in the inputs block **General Options**. When the flag is set to +**True**, the following line must include the name of the file containing +the inputs to the aeroacoustics model, which is discussed in +:numref:`aa-sec-BLinputs`. + + +.. container:: + :name: aa-tab:AD15 + + .. literalinclude:: example/AD15.ipt + :linenos: + :language: none + + +.. _aa-sec-MainInput: + +Main Input File +--------------- + +The aeroacoustics main input file comprises a series of inputs and flags +that should be set appropriately depending on the analysis that should +be run. These are split into the subfields General Options, +Aeroacoustics Models, Observer Input, and Outputs. + +Starting from the General Options, these are: + +- **Echo** – True/False: option to rewrite the input file with the correct + template + +- **DT_AA** – Float: time step of the aeroacoustics computations. Only + multiples of the time step **DTAero** of AeroDyn can be used. If set to + default, the time step DTAero is adopted. + +- **AAStart** – Float: time after which the AeroAcoustics module is run. + +- **BldPrcnt** – Float: percentage value of blade span measured from blade + tip that contributes to the noise emissions; 100% corresponds to the + entire blade from tip to root. + +The field Aeroacoustics Models lists all the flags for the actual noise +models: + +- **TIMod** – Integer 0/1/2: flag to set the turbulent inflow noise model; + 0 turns it off, 1 corresponds to the Amiet model discussed in + :numref:`aa-amiet`, and 2 corresponds to the Simplified Guidati model presented in + :numref:`aa-guidati`. + +- **TICalcMeth** – Integer 1/2: flag to set the calculation method for the + incident turbulence intensity. When set to 1, incident turbulence intensity is + defined in a user-defined grid; see :numref:`aa-sec-TIgrid`. When set to + 2, incident turbulence intensity is estimated from the time history of the + incident flow. + +- **TICalcTabFile** – String: name of the text file with the user-defined + turbulence intensity grid; see :numref:`aa-sec-TIgrid`. + +- **SurfRoughness** – Float: value of :math:`z_{0}` used to estimate + :math:`L_{t}` in the Amiet model. + +- **TBLTEMod** – Integer 0/1/2: flag to set the TBL-TE noise model; 0 turns + off the model, 1 uses the Brooks-Pope-Marcolini (BPM) airfoil noise + model (see :numref:`aa-turb-TE-bpm`), and 2 uses the TNO model described in + :numref:`aa-turb-TE-tno`. + +- **BLMod** – Integer 1/2: flag to set the calculation method for the + boundary layer characteristics; 1 uses the simplified equations from + the BPM model, 2 loads the files as described in :numref:`aa-sec-BLinputs`. Only + used if **TBLTEMod** is different than zero. + +- **TripMod** – Integer 0/1/2: if BLMod is set to 1, different + semiempirical parameters are used for a nontripped boundary layer + (**TRipMod=0**), heavily tripped boundary layer (**TRipMod=1**), or lightly + tripped boundary layer (**TRipMod=2**); 2 is typically used for + operational wind turbines, whereas 1 is often used for wind tunnel + airfoil models. + +- **LamMod** – Integer 0/1: flag to activate the laminar boundary layer – + vortex shedding model, presented in :numref:`aa-laminar-vortex`. + +- **TipMod** – Integer 0/1: flag to activate the tip vortex model, + presented in :numref:`aa-tip-vortex`. + +- **RoundedTip** – True/False: if **TipMod=1**, this flag switches between a + round tip (True) and a square tip (False), see :numref:`aa-tip-vortex`. + +- **Alprat** – Float: value of the slope of the lift coefficient curve at + blade tip; see :numref:`aa-tip-vortex`. + +- **BluntMod** – Integer 0/1: flag to activate (**BluntMod=1**) the + trailing-edge bluntness – vortex shedding model, see :numref:`aa-TE-vortex`. If + the flag is set to 1, the trailing-edge geometry must be specified in + the file(s) listed in the field Blade Properties. + +Next, the field Blade Properties lists three file names, often but not +necessarily identical, which contain the distributed properties +describing the detailed geometry of the trailing edge. These are +described in :numref:`aa-sec-TEgeom`. + +The field Observer Locations contains the path to the file where the +number of observers (NrObsLoc) and the respective locations are +specified; see :numref:`aa-sec-ObsPos`. + +Finally, the set Outputs contains a few options for the output data: + +- **AWeighting** – True/False: flag to set whether the sound pressure + levels are reported with (True) or without (False) the A-weighting + correction; see :numref:`aa-sec-ModelUsage`. + +- **NAAOutFile** – Integer 1/2/3: flag to set the desired output file. When + set to 1, a value of overall sound pressure level at every **DT_AA** time + step per observer is printed to file. When set to 2, the first output + is accompanied by a second file where the total sound pressure level + spectrum is printed per time step per observer. When set to + 3, the two first outputs are accompanied by a third file where the + sound pressure level spectrum per noise mechanism is printed per time + step per observer. When set to 4, a fourth file is generated with the + values of overall sound pressure levels per node, per blade, + per observer, and per time step. + +- The following line contains the file name used to store the outputs. + The file name is attached with a 1, 2, 3, and 4 flag based on the + **NAAOutFile** options. + +The file must be closed by an END command. + +.. container:: + :name: aa-tab:AeroAcousticsInput + + .. literalinclude:: example/AeroAcousticsInput.dat + :linenos: + :language: none + + +.. _aa-sec-BLinputs: + +Boundary Layer Inputs +--------------------- + +When the flag **BLMod** is set equal to 2, pretabulated properties of the +boundary layer must be provided and are used by the turbulent boundary +layer – trailing-edge noise models. The file name is to be specified in +the field BL_file among the inputs of the file with the airfoil polar +coefficients. One airfoil file must be specified per aerodynamic +station. + +.. container:: + :name: aa-tab:AFtab + + .. literalinclude:: example/AFtab.dat + :linenos: + :language: none + + +The file, in this example named **AF20_BL.txt**, contains 8 inputs, which +are tabulated for a given number of Reynolds numbers, ReListBL, and a +given number of angles of attack, aoaListBL. The inputs, which are +defined nondimensionally and must be provided for the suction and +pressure side of the airfoil above and below the trailing edge, are: + +- **Ue_Vinf** – flow velocity at the top of the boundary layer + +- **Dstar** – :math:`\delta^{*}`, boundary layer displacement thickness + +- **Delta** – :math:`\delta`, nominal boundary layer thickness + +- **Cf** – friction coefficient. + +In the following example, the file was generated thanks to a Python +script [4]_ that runs the boundary layer solver, XFoil. Notably, XFoil, +by default, does not return :math:`\delta`, but the boundary layer +momentum thickness, :math:`\theta`. :math:`\delta` can be reconstructed +using the expression from :cite:`aa-Drela:1987`: + +.. math:: + \delta = \theta \bullet \left( 3.15 + \frac{1.72}{H - 1} \right) + \delta^{*} + :label: eq:35 + +where :math:`H` is the kinematic shape factor, which is also among the standard +outputs of XFoil. Because it is usually impossible to obtain these values for +the whole ranges of Reynolds numbers and angles of attack, the code is set to +adopt the last available values and print to screen a warning. + + +.. container:: + :name: aa-tab:AF20_BL + + .. literalinclude:: example/AF20_BL.txt + :linenos: + :language: none + + +.. _aa-sec-ObsPos: + +Observer Positions +------------------ + +The number and position of observers is set in the file ObserverLocations, +which is explained in :numref:`aa-sec-MainInput`. The positions must be specified in the OpenFAST global +inertial frame coordinate system, which is located at the tower base and +has the x-axis pointing downwind, the y-axis pointing laterally, and the +z-axis pointing vertically upward. A scheme of the coordinate system for +the observers is shown in :numref:`aa-fig:ObsRefSys`. + +.. figure:: media/NoiseN010.png + :alt: Reference system for the observers + :name: aa-fig:ObsRefSys + :align: center + :width: 40.0% + + Reference system for the observers + +The International Energy Agency Wind Task 37 land-based reference wind +turbine, which is shown in :numref:`tab:ref-turb`, has a hub height of 110 meters and a +rotor radius of 65 meters, and has the International Electrotechnical +Commission 61400-11 standards compliant observer located at: + +x = 175 [m] + +y = 0 [m] + +z = 0 [m]. + +An example of a file listing four observers located at a 2-meter height +is shown here: + +.. container:: + :name: aa-tab:observer + + .. literalinclude:: example/Observer.txt + :linenos: + :language: none + + +.. _aa-sec-TIgrid: + +Turbulence Grid +--------------- + +When the flag **TICalcMeth** is set equal to 1, the grid of incident +turbulent intensity :math:`I_{1}` must be defined by the user. This is +done by creating a file called **TIGrid_In.txt**, which mimics a TurbSim +output file and contains a grid of turbulence intensity, which is +defined as a fraction value. The file defines a grid centered at hub +height and oriented with the OpenFAST global inertial frame coordinate +system; see :numref:`aa-fig:ObsRefSys`. A user-defined number of lateral and vertical +points equally spaced by a user-defined number of meters must be +specified. An example file for a 160 (lateral) by 180 (vertical) meters +grid looks like the following: + + +.. container:: + :name: aa-tab:TIgrid + + .. literalinclude:: example/TIGrid.txt + :linenos: + :language: none + + +.. _aa-sec-TEgeom: + +Trailing-Edge Geometry +---------------------- + +When the flag **BluntMod** is set to 1, the detailed geometry of the +trailing edge must be defined along the span. Two inputs must be +provided, namely the angle, :math:`\Psi,` between the suction and +pressure sides of the profile, right before the trailing-edge point, and +the height, :math:`h`, of the trailing edge. :math:`\Psi` must be +defined in degrees, while :math:`h` is in meters. Note that the BPM +trailing-edge bluntness model is very sensitive to these two parameters, +which, however, are often not easy to determine for real blades. +:numref:`aa-fig:GeomParamTE` shows the two inputs. + +.. figure:: media/NoiseN011.png + :alt: Geometric parameters of the trailing-edge bluntness + :name: aa-fig:GeomParamTE + :width: 100.0% + + Geometric parameters :math:`\mathbf{\Psi}` and + :math:`\mathbf{h}` of the trailing-edge bluntness + +The two distributions must be defined with the same spanwise resolution +of the AeroDyn15 blade file, such as: + +.. container:: + :name: aa-tab:BladeProp + + .. literalinclude:: example/BladeProp.dat + :linenos: + :language: none + +.. [4] + https://github.com/OpenFAST/python-toolbox diff --git a/docs/source/user/aerodyn-aeroacoustics/acronyms.rst b/docs/source/user/aerodyn-aeroacoustics/acronyms.rst new file mode 100644 index 0000000000..d444c40537 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/acronyms.rst @@ -0,0 +1,49 @@ +.. _AA-acronyms: + +List of Acronyms +---------------- + ++-----------+--------------------------------------------------------------+ ++ BPM + Brooks-Pope-Marcolini airfoil noise model + ++-----------+--------------------------------------------------------------+ ++ dB + decibels + ++-----------+--------------------------------------------------------------+ ++ dBA + A-weighted decibels + ++-----------+--------------------------------------------------------------+ ++ deg + degrees + ++-----------+--------------------------------------------------------------+ ++ Hz + hertz + ++-----------+--------------------------------------------------------------+ ++ IEA + International Energy Agency + ++-----------+--------------------------------------------------------------+ ++ kg + kilograms + ++-----------+--------------------------------------------------------------+ ++ kHz + kilohertz + ++-----------+--------------------------------------------------------------+ ++ LFC + low-frequency correction + ++-----------+--------------------------------------------------------------+ ++ m + meters + ++-----------+--------------------------------------------------------------+ ++ N + newtons + ++-----------+--------------------------------------------------------------+ ++ NREL + National Renewable Energy Laboratory + ++-----------+--------------------------------------------------------------+ ++ rad + radians + ++-----------+--------------------------------------------------------------+ ++ s + seconds + ++-----------+--------------------------------------------------------------+ ++ SPL + sound pressure level + ++-----------+--------------------------------------------------------------+ ++ TBL + turbulent boundary layer + ++-----------+--------------------------------------------------------------+ ++ TBL-TE + turbulent boundary layer – trailing edge + ++-----------+--------------------------------------------------------------+ ++ TNO + a Netherlands organization for applied scientific research + ++-----------+--------------------------------------------------------------+ ++ TE + trailing edge + ++-----------+--------------------------------------------------------------+ ++ TI + turbulent inflow + ++-----------+--------------------------------------------------------------+ ++ TUM + Technical University of Munich + ++-----------+--------------------------------------------------------------+ + diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt b/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt new file mode 100644 index 0000000000..26408a0873 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt @@ -0,0 +1,18 @@ +------- AERODYN v15.03.\* INPUT FILE ------------------------------------------------ +IEA Wind Task 37 land-based reference wind turbine +====== General Options =================================================== +False Echo - Echo the input to ".AD.ech"? (flag) +"default" DT_AA - Time interval for aerodynamic calculations {or "default"} (s) +1 WakeMod - Type of wake/induction model (switch) {0=none, 1=BEMT} +2 AFAeroMod - Type of blade airfoil aerodynamics model (switch +0 TwrPotent - Type tower influence on wind around the tower (switch) +False TwrShadow - Calculate tower influence on wind (flag) +False TwrAero - Calculate tower aerodynamic loads? (flag) +False FrozenWake - Assume frozen wake during linearization? (flag +False CavitCheck - Perform cavitation check? (flag) +True CompAA - Flag to compute AeroAcoustics calculation +"AeroAcousticsInput.dat" AA_InputFile +====== Environmental Conditions ========================================== +1.225. AirDens - Air density (kg/m^3) + +File continues... diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AF20_BL.txt b/docs/source/user/aerodyn-aeroacoustics/example/AF20_BL.txt new file mode 100644 index 0000000000..9db17a3352 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/AF20_BL.txt @@ -0,0 +1,136 @@ +! Boundary layer characteristics at the trailing edge for the airfoil coordinates of /Users/pbortolo/work/2_openfast/noise/verifyAA/OpenFAST_IEA_LB_RWT/Airfoils/AF20_Coords.txt +! Legend: aoa - angle of attack (deg), Re - Reynolds number (-, millions), PS - pressure side, SS - suction side, Ue_Vinf - edge velocity (-), Dstar - displacement thickness (-), Delta - nominal boundary layer thickness (-) Cf - friction coefficient (-) +4 ReListBL - Number of Reynolds numbers (it corresponds to the number of tables) +30 aoaListBL - Number of angles of attack (it corresponds to the number of rows in each table) +0.50 - Re +aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Delta_SS Delta_PS Cf_SS Cf_PS +(deg) (-) (-) (-) (-) (-) (-) (-) (-) +-5.00000 8.39390e-01 -8.37360e-01 7.43700e-03 1.07730e-02 2.75094e-02 5.15849e-02 1.13200e-03 1.58200e-03 +-3.96552 8.42050e-01 -8.40230e-01 8.26600e-03 9.29500e-03 2.98650e-02 4.87153e-02 1.04400e-03 1.85700e-03 +-2.93103 8.45320e-01 -8.43690e-01 9.08800e-03 8.10000e-03 3.19790e-02 4.70045e-02 9.58000e-04 2.16500e-03 +-1.89655 8.48230e-01 -8.46710e-01 9.97400e-03 7.33700e-03 3.44024e-02 4.50456e-02 8.90000e-04 2.35800e-03 +-0.86207 8.51550e-01 -8.50140e-01 1.09130e-02 6.54100e-03 3.68822e-02 4.30884e-02 8.26000e-04 2.59900e-03 + 0.17241 8.55000e-01 -8.53670e-01 1.18900e-02 5.92900e-03 3.96199e-02 4.27416e-02 7.79000e-04 2.87100e-03 + 1.20690 8.63820e-01 -1.04207e+00 1.22130e-02 9.89500e-03 4.18890e-02 1.68156e-02 8.18000e-04 -1.77000e-04 + 2.24138 8.61500e-01 -8.60210e-01 1.40420e-02 4.88700e-03 4.51813e-02 3.93105e-02 6.78000e-04 3.28700e-03 + 3.27586 8.64430e-01 -8.63080e-01 1.52900e-02 4.57300e-03 4.85938e-02 3.82233e-02 6.39000e-04 3.44000e-03 + 4.31034 8.67960e-01 -8.66600e-01 1.65660e-02 4.09100e-03 5.17768e-02 3.63749e-02 5.96000e-04 3.69000e-03 + 5.34483 8.72300e-01 -8.70850e-01 1.81000e-02 3.81700e-03 5.43379e-02 3.52278e-02 5.09000e-04 3.86300e-03 + 6.37931 8.77930e-01 -8.76410e-01 1.98500e-02 3.39700e-03 5.69109e-02 3.31481e-02 4.18000e-04 4.13900e-03 + 7.41379 8.86840e-01 -8.85140e-01 2.22250e-02 3.15000e-03 5.81316e-02 3.19040e-02 2.64000e-04 4.36900e-03 + 8.44828 9.00620e-01 -8.98660e-01 2.54290e-02 2.75900e-03 5.91946e-02 2.95298e-02 1.01000e-04 4.76300e-03 + 9.48276 9.20300e-01 -9.17700e-01 2.99830e-02 2.48300e-03 6.07767e-02 2.75551e-02 5.00000e-06 5.16000e-03 +10.51724 9.48080e-01 -9.44440e-01 3.80160e-02 2.13200e-03 6.65531e-02 2.48447e-02 -1.60000e-05 5.76800e-03 +11.55172 9.89560e-01 -9.84930e-01 5.83630e-02 1.85700e-03 8.76076e-02 2.18890e-02 -1.50000e-05 6.49000e-03 +12.58621 1.02883e+00 -1.02353e+00 8.80990e-02 1.66700e-03 1.21588e-01 2.00072e-02 -1.30000e-05 7.20200e-03 +13.62069 1.05789e+00 -1.05226e+00 1.18914e-01 1.51000e-03 1.57264e-01 1.78004e-02 -1.10000e-05 7.74800e-03 +14.65517 1.07975e+00 -1.07394e+00 1.48726e-01 1.41900e-03 1.91423e-01 1.65710e-02 -1.00000e-05 8.15600e-03 +15.68966 1.09657e+00 -1.09067e+00 1.76430e-01 1.34400e-03 2.22657e-01 1.56180e-02 -9.00000e-06 8.50600e-03 +16.72414 1.11040e+00 -1.10441e+00 2.02883e-01 1.26100e-03 2.52158e-01 1.43276e-02 -9.00000e-06 8.80900e-03 +17.75862 1.12290e+00 -1.11682e+00 2.29606e-01 1.20600e-03 2.81695e-01 1.35432e-02 -8.00000e-06 9.07600e-03 +18.79310 1.13461e+00 -1.12844e+00 2.55478e-01 1.15500e-03 3.10143e-01 1.28744e-02 -8.00000e-06 9.34700e-03 +19.82759 1.14605e+00 -1.13974e+00 2.80923e-01 1.08200e-03 3.37970e-01 1.16844e-02 -8.00000e-06 9.61200e-03 +20.86207 1.15722e+00 -1.15073e+00 3.05117e-01 1.03800e-03 3.64240e-01 1.10866e-02 -7.00000e-06 9.87000e-03 +21.89655 1.16808e+00 -1.16138e+00 3.27770e-01 9.81000e-04 3.88826e-01 1.02373e-02 -7.00000e-06 1.01370e-02 +22.93103 1.17845e+00 -1.17148e+00 3.48909e-01 9.33000e-04 4.11299e-01 9.52780e-03 -7.00000e-06 1.03870e-02 +23.96552 1.18930e+00 -1.18205e+00 3.70277e-01 8.93000e-04 4.34300e-01 9.01762e-03 -7.00000e-06 1.06550e-02 +25.00000 1.19987e+00 -1.19227e+00 3.90503e-01 8.36000e-04 4.55921e-01 8.12755e-03 -7.00000e-06 1.09080e-02 +1.00 - Re +aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Delta_SS Delta_PS Cf_SS Cf_PS +(deg) (-) (-) (-) (-) (-) (-) (-) (-) +-5.00000 8.34300e-01 -8.32480e-01 6.49600e-03 7.74600e-03 2.28566e-02 3.97467e-02 8.39000e-04 1.54900e-03 +-3.96552 8.37330e-01 -8.35790e-01 7.10100e-03 6.55800e-03 2.45059e-02 3.67266e-02 7.84000e-04 1.80000e-03 +-2.93103 8.40670e-01 -8.39370e-01 7.75600e-03 5.65600e-03 2.62162e-02 3.42658e-02 7.27000e-04 2.03700e-03 +-1.89655 8.44170e-01 -8.43070e-01 8.45300e-03 4.96000e-03 2.79616e-02 3.22259e-02 6.72000e-04 2.25700e-03 +-0.86207 8.47840e-01 -8.46890e-01 9.21600e-03 4.45100e-03 2.98142e-02 3.07238e-02 6.18000e-04 2.45400e-03 + 0.17241 8.51730e-01 -8.50900e-01 1.00790e-02 3.95100e-03 3.18738e-02 2.89503e-02 5.65000e-04 2.66300e-03 + 1.20690 8.55470e-01 -8.54730e-01 1.09340e-02 3.54400e-03 3.37289e-02 2.74209e-02 5.12000e-04 2.86100e-03 + 2.24138 8.59040e-01 -8.58320e-01 1.18130e-02 3.25200e-03 3.55603e-02 2.64490e-02 4.62000e-04 3.03800e-03 + 3.27586 8.63480e-01 -8.62770e-01 1.29500e-02 2.91700e-03 3.78947e-02 2.47691e-02 4.08000e-04 3.23200e-03 + 4.31034 8.67590e-01 -8.66830e-01 1.40320e-02 2.69800e-03 3.97441e-02 2.39342e-02 3.50000e-04 3.40400e-03 + 5.34483 8.72380e-01 -8.71540e-01 1.53110e-02 2.43000e-03 4.18407e-02 2.22446e-02 2.92000e-04 3.59200e-03 + 6.37931 8.78360e-01 -8.77360e-01 1.68420e-02 2.23600e-03 4.38267e-02 2.12352e-02 2.20000e-04 3.78300e-03 + 7.41379 8.86030e-01 -8.84810e-01 1.87390e-02 2.00100e-03 4.60113e-02 1.94428e-02 1.44000e-04 4.00100e-03 + 8.44828 8.96310e-01 -8.94850e-01 2.13480e-02 1.83100e-03 4.88127e-02 1.83696e-02 5.90000e-05 4.24200e-03 + 9.48276 9.25990e-01 -9.23230e-01 2.81520e-02 1.56900e-03 5.51012e-02 1.62260e-02 -1.00000e-06 4.73700e-03 +10.51724 9.66170e-01 -9.62320e-01 4.28900e-02 1.36700e-03 7.03103e-02 1.45187e-02 -9.00000e-06 5.34800e-03 +11.55172 1.00255e+00 -9.97860e-01 6.33540e-02 1.21700e-03 9.26255e-02 1.29836e-02 -7.00000e-06 5.90200e-03 +12.58621 1.03100e+00 -1.02578e+00 8.62500e-02 1.10600e-03 1.18923e-01 1.16999e-02 -6.00000e-06 6.34900e-03 +13.62069 1.05406e+00 -1.04857e+00 1.10634e-01 1.04100e-03 1.47132e-01 1.09721e-02 -6.00000e-06 6.70700e-03 +14.65517 1.07334e+00 -1.06769e+00 1.35720e-01 9.66000e-04 1.76016e-01 9.96935e-03 -5.00000e-06 7.01900e-03 +15.68966 1.08881e+00 -1.08308e+00 1.60129e-01 9.17000e-04 2.03832e-01 9.33244e-03 -5.00000e-06 7.27400e-03 +16.72414 1.10158e+00 -1.09579e+00 1.83765e-01 8.82000e-04 2.30423e-01 8.89329e-03 -5.00000e-06 7.49000e-03 +17.75862 1.11342e+00 -1.10758e+00 2.08205e-01 8.32000e-04 2.57695e-01 8.20477e-03 -4.00000e-06 7.69800e-03 +18.79310 1.12407e+00 -1.11817e+00 2.32504e-01 8.01000e-04 2.84583e-01 7.81234e-03 -4.00000e-06 7.88600e-03 +19.82759 1.13501e+00 -1.12904e+00 2.57953e-01 7.76000e-04 3.12682e-01 7.52201e-03 -4.00000e-06 8.07500e-03 +20.86207 1.14614e+00 -1.14008e+00 2.83630e-01 7.33000e-04 3.41005e-01 6.90325e-03 -4.00000e-06 8.27100e-03 +21.89655 1.15868e+00 -1.15248e+00 3.10888e-01 7.07000e-04 3.71055e-01 6.60979e-03 -4.00000e-06 8.48600e-03 +22.93103 1.17050e+00 -1.16410e+00 3.35623e-01 6.81000e-04 3.98279e-01 6.28286e-03 -3.00000e-06 8.69100e-03 +23.96552 1.18348e+00 -1.17683e+00 3.61314e-01 6.45000e-04 4.26528e-01 5.81057e-03 -3.00000e-06 8.91700e-03 +25.00000 1.19753e+00 -1.19058e+00 3.87323e-01 6.21000e-04 4.54991e-01 5.52432e-03 -3.00000e-06 9.15800e-03 +5.00 - Re +aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Delta_SS Delta_PS Cf_SS Cf_PS +(deg) (-) (-) (-) (-) (-) (-) (-) (-) +-5.00000 8.23420e-01 -8.21880e-01 4.67200e-03 4.76700e-03 1.77334e-02 2.96859e-02 6.92000e-04 1.41000e-03 +-3.96552 8.25550e-01 -8.24400e-01 5.04400e-03 4.14000e-03 1.88321e-02 2.75480e-02 6.57000e-04 1.55000e-03 +-2.93103 8.27930e-01 -8.27220e-01 5.46200e-03 3.53900e-03 2.00407e-02 2.52464e-02 6.21000e-04 1.70500e-03 +-1.89655 8.30490e-01 -8.30120e-01 5.91700e-03 3.10400e-03 2.13254e-02 2.34284e-02 5.86000e-04 1.84000e-03 +-0.86207 8.33100e-01 -8.33000e-01 6.40000e-03 2.77600e-03 2.26264e-02 2.19701e-02 5.50000e-04 1.95800e-03 + 0.17241 8.35520e-01 -8.35690e-01 6.86100e-03 2.45300e-03 2.37731e-02 2.03359e-02 5.15000e-04 2.08300e-03 + 1.20690 8.38270e-01 -8.38660e-01 7.40600e-03 2.17500e-03 2.51176e-02 1.87906e-02 4.79000e-04 2.20700e-03 + 2.24138 8.41350e-01 -8.41880e-01 8.04900e-03 1.95800e-03 2.66635e-02 1.75032e-02 4.40000e-04 2.31900e-03 + 3.27586 8.43950e-01 -8.44520e-01 8.65200e-03 1.80300e-03 2.79650e-02 1.65339e-02 4.03000e-04 2.40900e-03 + 4.31034 8.48180e-01 -8.48810e-01 9.58300e-03 1.61000e-03 3.00737e-02 1.51804e-02 3.59000e-04 2.53200e-03 + 5.34483 8.53570e-01 -8.54090e-01 1.08300e-02 1.48600e-03 3.27612e-02 1.43249e-02 3.08000e-04 2.63700e-03 + 6.37931 8.72880e-01 -8.73060e-01 1.51570e-02 1.28200e-03 4.16833e-02 1.28096e-02 1.92000e-04 2.88700e-03 + 7.41379 8.92130e-01 -8.91760e-01 1.98220e-02 1.14700e-03 4.87740e-02 1.17767e-02 8.30000e-05 3.11600e-03 + 8.44828 9.17360e-01 -9.16020e-01 2.50640e-02 9.92000e-04 5.31945e-02 1.04181e-02 2.00000e-06 3.41900e-03 + 9.48276 9.42910e-01 -9.40410e-01 3.17040e-02 8.85000e-04 5.85499e-02 9.42477e-03 -1.00000e-06 3.70700e-03 +10.51724 9.64800e-01 -9.61630e-01 4.02300e-02 7.96000e-04 6.64893e-02 8.47323e-03 -2.00000e-06 3.96100e-03 +11.55172 9.86420e-01 -9.82570e-01 5.11880e-02 7.23000e-04 7.76623e-02 7.65452e-03 -2.00000e-06 4.20700e-03 +12.58621 1.00657e+00 -1.00210e+00 6.43270e-02 6.71000e-04 9.20001e-02 7.06023e-03 -2.00000e-06 4.43100e-03 +13.62069 1.02475e+00 -1.01984e+00 7.93340e-02 6.16000e-04 1.09051e-01 6.35528e-03 -1.00000e-06 4.64000e-03 +14.65517 1.04370e+00 -1.03850e+00 9.84840e-02 5.79000e-04 1.31195e-01 5.91001e-03 -1.00000e-06 4.84500e-03 +15.68966 1.06004e+00 -1.05467e+00 1.18503e-01 5.43000e-04 1.54410e-01 5.44594e-03 -1.00000e-06 5.02500e-03 +16.72414 1.07448e+00 -1.06905e+00 1.39604e-01 5.14000e-04 1.78759e-01 5.05912e-03 -1.00000e-06 5.18500e-03 +17.75862 1.08720e+00 -1.08175e+00 1.61656e-01 4.93000e-04 2.03997e-01 4.79726e-03 -1.00000e-06 5.32500e-03 +18.79310 1.09867e+00 -1.09324e+00 1.84226e-01 4.68000e-04 2.29525e-01 4.45243e-03 -1.00000e-06 5.45500e-03 +19.82759 1.10970e+00 -1.10430e+00 2.08500e-01 4.51000e-04 2.56774e-01 4.24858e-03 -1.00000e-06 5.57800e-03 +20.86207 1.11936e+00 -1.11397e+00 2.32097e-01 4.34000e-04 2.83065e-01 4.03443e-03 -1.00000e-06 5.69000e-03 +21.89655 1.12815e+00 -1.12274e+00 2.54679e-01 4.14000e-04 3.07965e-01 3.77358e-03 -1.00000e-06 5.79400e-03 +22.93103 1.13774e+00 -1.13227e+00 2.78750e-01 4.00000e-04 3.34530e-01 3.60784e-03 -1.00000e-06 5.90600e-03 +23.96552 1.14721e+00 -1.14164e+00 3.02299e-01 3.84000e-04 3.60352e-01 3.41109e-03 -1.00000e-06 6.01800e-03 +25.00000 1.15816e+00 -1.15244e+00 3.27151e-01 3.68000e-04 3.87710e-01 3.21949e-03 -1.00000e-06 6.14600e-03 +10.00 - Re +aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Delta_SS Delta_PS Cf_SS Cf_PS +(deg) (-) (-) (-) (-) (-) (-) (-) (-) +-5.00000 8.19760e-01 -8.18060e-01 4.17800e-03 4.54900e-03 1.65706e-02 2.88150e-02 6.56000e-04 1.23100e-03 +-3.96552 8.21540e-01 -8.20450e-01 4.52500e-03 3.74000e-03 1.76308e-02 2.59028e-02 6.23000e-04 1.39100e-03 +-2.93103 8.23580e-01 -8.22970e-01 4.89400e-03 3.21700e-03 1.87333e-02 2.38284e-02 5.91000e-04 1.51700e-03 +-1.89655 8.25560e-01 -8.25320e-01 5.25400e-03 2.85300e-03 1.97567e-02 2.22669e-02 5.60000e-04 1.62100e-03 +-0.86207 8.27870e-01 -8.28060e-01 5.67900e-03 2.46600e-03 2.09522e-02 2.03860e-02 5.28000e-04 1.74400e-03 + 0.17241 8.30330e-01 -8.30840e-01 6.14400e-03 2.18100e-03 2.22219e-02 1.88758e-02 4.96000e-04 1.84900e-03 + 1.20690 8.32880e-01 -8.33650e-01 6.64800e-03 1.94100e-03 2.35312e-02 1.74735e-02 4.63000e-04 1.94900e-03 + 2.24138 8.35130e-01 -8.36090e-01 7.13000e-03 1.75100e-03 2.46910e-02 1.62700e-02 4.31000e-04 2.03800e-03 + 3.27586 8.39970e-01 -8.41060e-01 8.09900e-03 1.56800e-03 2.72181e-02 1.50508e-02 3.88000e-04 2.14300e-03 + 4.31034 8.50470e-01 -8.51560e-01 1.01990e-02 1.37300e-03 3.25448e-02 1.36378e-02 3.18000e-04 2.29400e-03 + 5.34483 8.64450e-01 -8.65280e-01 1.32660e-02 1.23700e-03 3.92329e-02 1.26866e-02 2.31000e-04 2.45100e-03 + 6.37931 8.78610e-01 -8.79110e-01 1.65810e-02 1.08900e-03 4.49765e-02 1.14397e-02 1.47000e-04 2.62200e-03 + 7.41379 8.91030e-01 -8.91080e-01 1.96290e-02 9.93000e-04 4.89936e-02 1.06282e-02 7.60000e-05 2.76500e-03 + 8.44828 9.08900e-01 -9.08620e-01 2.35230e-02 8.71000e-04 5.22284e-02 9.45732e-03 2.00000e-06 2.96800e-03 + 9.48276 9.32700e-01 -9.30700e-01 2.84210e-02 7.79000e-04 5.52443e-02 8.61055e-03 -0.00000e+00 3.20000e-03 +10.51724 9.51380e-01 -9.48770e-01 3.46600e-02 6.96000e-04 6.05165e-02 7.64709e-03 -1.00000e-06 3.39700e-03 +11.55172 9.71740e-01 -9.68450e-01 4.35850e-02 6.37000e-04 6.90670e-02 6.98615e-03 -1.00000e-06 3.59500e-03 +12.58621 9.91260e-01 -9.87290e-01 5.44080e-02 5.84000e-04 8.03205e-02 6.33577e-03 -1.00000e-06 3.78700e-03 +13.62069 1.00996e+00 -1.00542e+00 6.74960e-02 5.36000e-04 9.47613e-02 5.73102e-03 -1.00000e-06 3.97000e-03 +14.65517 1.02771e+00 -1.02275e+00 8.31660e-02 5.06000e-04 1.12645e-01 5.35979e-03 -1.00000e-06 4.13700e-03 +15.68966 1.04427e+00 -1.03905e+00 1.00836e-01 4.71000e-04 1.33082e-01 4.88548e-03 -1.00000e-06 4.29600e-03 +16.72414 1.06019e+00 -1.05485e+00 1.21136e-01 4.45000e-04 1.56673e-01 4.55077e-03 -1.00000e-06 4.44600e-03 +17.75862 1.07407e+00 -1.06868e+00 1.42220e-01 4.22000e-04 1.81035e-01 4.24533e-03 -1.00000e-06 4.57900e-03 +18.79310 1.08623e+00 -1.08087e+00 1.64037e-01 4.01000e-04 2.06006e-01 3.94306e-03 -0.00000e+00 4.69600e-03 +19.82759 1.09748e+00 -1.09215e+00 1.87080e-01 3.86000e-04 2.32142e-01 3.76503e-03 -0.00000e+00 4.80500e-03 +20.86207 1.10794e+00 -1.10267e+00 2.10804e-01 3.67000e-04 2.58816e-01 3.50553e-03 -0.00000e+00 4.90800e-03 +21.89655 1.11776e+00 -1.11253e+00 2.35256e-01 3.54000e-04 2.86067e-01 3.34709e-03 -0.00000e+00 5.00500e-03 +22.93103 1.12664e+00 -1.12138e+00 2.58366e-01 3.43000e-04 3.11568e-01 3.20986e-03 -0.00000e+00 5.09600e-03 +23.96552 1.13635e+00 -1.13106e+00 2.83067e-01 3.28000e-04 3.38816e-01 3.02058e-03 -0.00000e+00 5.19400e-03 +25.00000 1.14573e+00 -1.14034e+00 3.06604e-01 3.16000e-04 3.64612e-01 2.86692e-03 -0.00000e+00 5.29100e-03 diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AFtab.dat b/docs/source/user/aerodyn-aeroacoustics/example/AFtab.dat new file mode 100644 index 0000000000..92aa5948e8 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/AFtab.dat @@ -0,0 +1,12 @@ +! ------------ AirfoilInfo v1.01.x Input File ---------------------------------- +! AeroElasticSE FAST driver +! +! +! ------------------------------------------------------------------------------ +DEFAULT InterpOrd ! Interpolation order to use for quasi-steady table lookup {1=linear; 3=cubic spline; "default"} [default=3] +1 NonDimArea ! The non-dimensional area of the airfoil (area/chord^2) (set to 1.0 if unsure or unneeded) +@"AF20_Coords.txt" NumCoords ! The number of coordinates in the airfoil shape file. Set to zero if coordinates not included. +AF20_BL.txt BL_file ! The file name including the boundary layer characteristics of the profile. Ignored if the aeroacoustic module is not called. +1 NumTabs ! Number of airfoil tables in this file. Each table must have lines for Re and Ctrl. +! ------------------------------------------------------------------------------ +! data for table 1 diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat new file mode 100644 index 0000000000..f79c9aae0d --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat @@ -0,0 +1,31 @@ +------- AeroAcoustics Module v1.00.* INPUT FILE ------------------------------------------------ +IEA task 37 RWT turbine -- https://github.com/IEAWindTask37/IEA-3.4-130-RWT +====== General Options ============================================================================ +False Echo - Echo the input to ".AD.ech"? (flag) +0.1 DT_AA - Time interval for aeroacoustics calculations (s), must be a multiple of DT_Aero from AeroDyn15 (or "default") +0 AAStart - Time after which the AeroAcoustics module is run (s) +70 BldPrcnt - Percentage of the blade span, starting from the tip, that will contribute to the overall noise levels. (float) +====== Aeroacoustic Models ============================================================================ +2 TIMod - Turbulent Inflow noise model {0: none, 1: Amiet 2: Amiet + Simplified Guidati} (switch) +1 TICalcMeth - Method to estimate turbulence intensity incident to the profile {1: given table, 2: computed on the fly} (switch) [Only used if TIMod!=0] +"TIGrid_InVerify.txt" TICalcTabFile - Name of the file containing the table for incident turbulence intensity (-) [Only used if TiCalcMeth == 1] +0.5 SurfRoughness- Surface roughness value used to estimate the turbulent length scale in Amiet model (m) +1 TBLTEMod - Turbulent Boundary Layer-Trailing Edge noise calculation {0: none, 1:BPM, 2: TNO} (switch) +1 BLMod - Calculation method for boundary layer properties, {1: BPM, 2: Pretabulated} (switch) +1 TripMod - Boundary layer trip model {0:no trip, 1: heavy trip, 2: light trip} (switch) [Only used if BLMod=1] +0 LamMod - Laminar boundary layer noise model {0:none, 1: BPM} (switch) +0 TipMod - Tip vortex noise model {0:none, 1: BPM} (switch) +True RoundedTip - Logical indicating rounded tip (flag) [Only used if TipMod=1] +1.0 Alprat - Tip lift curve slope (Default = 1.0) [Only used if TipMod=1] +0 BluntMod - Trailing-edge-bluntness – Vortex-shedding model {0:none, 1: BPM} (switch) +"AABlade1.dat" AABlFile(1) - Name of file containing distributed aerodynamic properties for Blade #1 (-) +"AABlade1.dat" AABlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) +"AABlade1.dat" AABlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) +====== Observer Input =================================================================== +"AA_ObserverLocations.dat" ObserverLocations - Name of file containing all observer locations X Y Z (-) +====== Outputs ==================================================================================== +False AWeighting - A-weighting Flag (flag) +3 NrOutFile - Number of Output files. 1 for Time Dependent Overall SPL, 2 for both 1 and Frequency and Time Dependent SPL as well, or 3 for both 1 and 2 and Acoustics mechanism dependent, 4 for 1-3 and the overall sound pressure levels per blade per node per observer +"IEA_LB_RWT-AeroAcoustics_" AAOutFile - No Extension needed the resulting file will have .out Name of file containing +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/aerodyn-aeroacoustics/example/BladeProp.dat b/docs/source/user/aerodyn-aeroacoustics/example/BladeProp.dat new file mode 100644 index 0000000000..12aa4c92bb --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/BladeProp.dat @@ -0,0 +1,35 @@ +Example aerodynamic blade input properties +====== Blade Properties ========================================== +30 NumBlNds - Number of blade nodes used in the analysis (-) +TEAngle TEThick +(deg) (m) +10.000000E+00 0.03000E+00 +10.000000E+00 0.02900E+00 +10.000000E+00 0.02800E+00 +10.000000E+00 0.02700E+00 +10.000000E+00 0.02600E+00 +10.000000E+00 0.02500E+00 +10.000000E+00 0.02400E+00 +10.000000E+00 0.02300E+00 +10.000000E+00 0.02200E+00 +10.000000E+00 0.02100E+00 +10.000000E+00 0.02000E+00 +10.000000E+00 0.01900E+00 +10.000000E+00 0.01800E+00 +10.000000E+00 0.01700E+00 +10.000000E+00 0.01600E+00 +10.000000E+00 0.01500E+00 +10.000000E+00 0.01400E+00 +10.000000E+00 0.01300E+00 +10.000000E+00 0.01200E+00 +10.000000E+00 0.01100E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 +10.000000E+00 0.01000E+00 diff --git a/docs/source/user/aerodyn-aeroacoustics/example/Observer.txt b/docs/source/user/aerodyn-aeroacoustics/example/Observer.txt new file mode 100644 index 0000000000..d8a8b78cee --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/Observer.txt @@ -0,0 +1,6 @@ +4 NrObsLoc - Total Number of observer locations +X Observer location in tower-base coordinate X horizontal (m), Y Observer location in tower-base coordinate Y Lateral (m), Z Observer location in tower-base coordinate Z Vertical (m) +-200 -200 2 +-200 +200 2 ++200 -200 2 ++200 +200 2 diff --git a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt new file mode 100644 index 0000000000..2403826069 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt @@ -0,0 +1,11 @@ +Total Grid points In Y (lateral), Starts from - radius goes to + radius+ +4 +Total Grid points In Z (vertical), Starts from bottom tip (hub-radius) +3 +Grid spacing In Y (lateral) +40 +Grid spacing In Z (vertical) +60 +0.1200 0.1200 0.1200 0.1200 +0.1100 0.1100 0.1100 0.1100 +0.1000 0.1000 0.1000 0.1000 diff --git a/docs/source/user/aerodyn-aeroacoustics/index.rst b/docs/source/user/aerodyn-aeroacoustics/index.rst new file mode 100644 index 0000000000..c6fd838d9b --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/index.rst @@ -0,0 +1,43 @@ +.. _AeroAcoustics: + +Aeroacoustics Noise Model of OpenFAST +===================================== + +.. only:: html + + This report describes theory and application of a newly released model + of OpenFAST to simulate the aeroacoustics noise generated by the rotor + of an arbitrary wind turbine. OpenFAST is a fully open-source, publicly + available wind turbine analysis tool actively developed at the National + Renewable Energy Laboratory. The aeroacoustics model, which is also + fully open source and publicly available, is based on work performed + over the past three decades. Frequency-based models for turbulent + inflow; turbulent boundary layer – trailing edge; laminar boundary layer + –vortex shedding; tip vortex; and trailing edge bluntness – vortex + shedding noise mechanisms are included. A simple directivity model is + also included. + + The noise models are exercised simulating the aeroacoustics noise + emissions of the International Energy Agency Wind Task 37 land-based + reference wind turbine. A code-to-code comparison between the + implementation presented here and the implementation available at the + Wind Energy Institute of the Technical University of Munich, Germany, is + also presented. + + The documentation here was derived from NREL Technical Report TP-5000-75731 + by P. Bortolotti et al. (`https://www.nrel.gov/docs/fy20osti/75731.pdf + `_) + + + +.. toctree:: + :maxdepth: 2 + + acronyms.rst + symbols.rst + 01-introduction.rst + 02-noise-models.rst + 03-model-verification.rst + 04-conclusions.rst + App-usage.rst + refs.rst diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN002.jpeg b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN002.jpeg new file mode 100644 index 0000000000..6f4ae6fb63 Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN002.jpeg differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN003.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN003.png new file mode 100644 index 0000000000..056545a2ef Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN003.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN004.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN004.png new file mode 100644 index 0000000000..2aa065769b Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN004.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN005.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN005.png new file mode 100644 index 0000000000..7125e90374 Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN005.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN006.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN006.png new file mode 100644 index 0000000000..313d57fcce Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN006.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN007.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN007.png new file mode 100644 index 0000000000..e5a627bfe9 Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN007.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN008.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN008.png new file mode 100644 index 0000000000..6ea66edd59 Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN008.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN009.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN009.png new file mode 100644 index 0000000000..95ec7140aa Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN009.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN010.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN010.png new file mode 100644 index 0000000000..8580ad42ee Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN010.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN011.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN011.png new file mode 100644 index 0000000000..168a9e632d Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN011.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/media/NoiseN012.png b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN012.png new file mode 100644 index 0000000000..5da7c52d87 Binary files /dev/null and b/docs/source/user/aerodyn-aeroacoustics/media/NoiseN012.png differ diff --git a/docs/source/user/aerodyn-aeroacoustics/references.bib b/docs/source/user/aerodyn-aeroacoustics/references.bib new file mode 100644 index 0000000000..d710ca8372 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/references.bib @@ -0,0 +1,183 @@ +@article{Amiet:1975, + author= {Roy K. Amiet}, + title= {Acoustic Radiation from an Airfoil in a Turbulent Stream}, + journal= {Journal of Sound and Vibration}, + volume= {41}, + number= {4}, + pages= {407–420}, + year= {1975}, + doi= {10.1016/S0022-460X(75)80105-2} +} + +@techreport{Bortolotti:2019, + author= {Pietro Bortolotti and Helena Canet Tarres and Katherine Dykes and Karl Merz and Latha Sethuraman and David Verelst and Frederik Zahle}, + year= {2019}, + title= {Systems Engineering in Wind Energy - WP2.1 Reference Wind Turbines}, + institution= {IEA Technical Report}, + URL= {https://www.nrel.gov/docs/fy19osti/73492.pdf} +} + +@techreport{Brooks:1989, + author= {Thomas F. Brooks and D. Stuart Pope and Michael A. Marcolini}, + year= {1989}, + title= {Airfoil Self-Noise and Prediction}, + institution={NASA}, + type= {Reference Publication}, + number= { 1218} +} + +@article{Drela:1987, + author = {Drela, Mark and Giles, Michael B.}, + title = {Viscous-inviscid analysis of transonic and low Reynolds number airfoils}, + journal = {AIAA Journal}, + volume = {25}, + number = {10}, + pages = {1347-1355}, + year = {1987}, + doi = {10.2514/3.9789}, +} + +@inproceedings{Guidati:1997, + author = {Gianfranco Guidati and Rainer Bareiss and Siegfried Wagner and Rene Parchen and Gianfranco Guidati and Rainer Bareiss and Siegfried Wagner and Rene Parchen}, + title = {Simulation and measurement of inflow-turbulence noise on airfoils}, + booktitle = {3rd AIAA/CEAS Aeroacoustics Conference}, + year= {1997}, + doi = {10.2514/6.1997-1698} +} + + +@article{Lowson:1970, + author= {Martin V. Lowson}, + year= {1970}, + title= {Theoretical Analysis of Compressor Noise Evaluation}, + journal= {The Journal of the Acoustical Society of America}, + volume= {47}, + pages= {371–385}, + doi= {10.1121/1.1911508} +} + +@article{Klein:2018, + author= {Levin Klein and Jonas Gude and Florian Wenz and Thorsten Lutz and Ewald Krämer}, + year= {2018}, + title= {Advanced Computational Fluid Dynamics (CFD)–Multi-Body Simulation (MBS) Coupling to Assess Low-Frequency Emissions from Wind Turbines}, + journal= {Wind Energy Science Journal}, + volume= {3}, + pages= {713–728}, + doi= {10.5194/wes-3-713-2018} +} + +@techreport{MoriartyMigliore:2003, + author= {Patrick J. Moriarty and Paul G. Migliore}, + year= {2003}, + title= {Semi-Empirical Aeroacoustic Noise Prediction Code for Wind Turbines}, + address= {Golden, CO}, + institution= {National Renewable Energy Laboratory}, + number= {NREL/TP-500-34478}, + URL= {https://www.nrel.gov/docs/fy04osti/34478.pdf} +} + +@inproceedings{MoriartyGuidatiMigliore:2004, + author = {Patrick Moriarty and Gianfranco Guidati and Paul Migliore}, + title = {Recent Improvement of a Semi-Empirical Aeroacoustic Prediction Code for Wind Turbines}, + booktitle = {10th AIAA/CEAS Aeroacoustics Conference}, + year= {2004}, + doi = {10.2514/6.2004-3041} +} + +@inproceedings{MoriartyGuidatiMigliore:2005, + author = {Patrick Moriarty and Gianfranco Guidati and Paul Migliore}, + title = {Prediction of Turbulent Inflow and Trailing-Edge Noise for Wind Turbines}, + booktitle = {11th AIAA/CEAS Aeroacoustics Conference}, + year = {2005}, + doi = {10.2514/6.2005-2881} +} + +@techreport{MoriartyHansen:2005, + author= {Patrick J. Moriarty and A. C. Hansen}, + year= {2005}, + title= {AeroDyn Theory Manual}, + address= {Golden, CO}, + institution= {National Renewable Energy Laboratory}, + number= {NREL/TP-500-36881}, + URL= {https://www.nrel.gov/docs/fy05osti/36881.pdf} +} + +@techreport{Moriarty:2005, + author= { Patrick J. Moriarty}, + year= {2005}, + title= {NAFNoise User's Guide}, + address= {Golden, CO}, + institution= {National Renewable Energy Laboratory}, + URL= {https://github.com/NREL/NAFNoise/blob/master/NAFNoise.pdf} +} + +@misc{xfoil:699, + author= {Mark Drela}, + title= {{XF}oil, release 6.99}, + url= {https://web.mit.edu/drela/Public/web/xfoil/} +} + +@misc{openfast:2019, + title= {Open{FAST}, dev branch}, + year= {2019}, + publisher= {GitHub}, + journal= {GitHub repository}, + url= {https://github.com/OpenFAST/openfast} +} + +@techreport{Parchen:1998, + author= {René R. Parchen}, + year= {1998}, + title= {Progress Report {DRAW}: A Prediction Scheme for Trailing Edge Noise Based on Detailed Boundary Layer Characteristics}, + institution= {TNO Institute of Applied Physics} +} + + +@inproceedings{Paterson:1976, + author = {R. Paterson and R. Amiet}, + title = {Acoustic radiation and surface pressure characteristics of an airfoil due to incident turbulence}, + booktitle = {3rd Aeroacoustics Conference}, + year= {1976}, + chapter = {}, + pages = {}, + publisher= {AIAA}, + doi = {10.2514/6.1976-571} +} + +@article{Sucameli:2018, + doi = {10.1088/1742-6596/1037/2/022038}, + year = 2018, + month = {jun}, + publisher = {{IOP} Publishing}, + volume = {1037}, + pages = {022038}, + author = {CR Sucameli and P Bortolotti and A Croce and CL Bottasso}, + title = {Comparison of some wind turbine noise emission models coupled to {BEM} aerodynamics}, + journal = {Journal of Physics: Conference Series}, + abstract = {Noise is an important design driver for onshore wind turbines. Therefore, there is a need to include validated noise prediction models within wind turbine and wind plant design procedures. However, the literature presents a multitude of different models and formulations, combined with a severe lack of publicly available experimental data. The present work presents a comparison between semi-empirical frequency-domain methods coupled to blade element momentum (BEM) aerodynamics, which is the typical approach used for the transient aeroelastic analysis of wind turbines. Among the various noise sources, only turbulent boundary layer – trailing edge and turbulent inflow noise models have been considered in the present analysis. The noise models are benchmarked in terms of emission spectra, highlighting differences and discrepancies. A time-domain Ffowcs Williams-Hawkings formulation is also coupled to the same BEM model, investigating its ability in predicting low frequency emissions. Thanks to this study, a few inconsistencies among published noise models are identified and reported.} +} + + +@techreport{Viterna:1981, + author= {Larry A. Viterna}, + year= {1981}, + title= {Method for Predicting Impulsive Noise Generated by Wind Turbine Rotors}, + number= {DOE/NASA/20320-36}, + institution= {}, + URL= {https://ntrs.nasa.gov/archive/nasa/casi.ntrs.nasa.gov/19820013840.pdf} +} + + + +@article{Zhu:2005, + author= {Wei J. Zhu and Nicolai Heilskov and Wen Zhong Shen}, + year= {2005}, + title= {Modeling of Aerodynamically Generated Noise From Wind Turbines}, + journal= {Journal of Solar Energy Engineering}, + volume= {127}, + number= {4}, + pages= {517-528}, + doi= {10.1115/1.2035700} +} + + diff --git a/docs/source/user/aerodyn-aeroacoustics/refs.rst b/docs/source/user/aerodyn-aeroacoustics/refs.rst new file mode 100644 index 0000000000..06850d67da --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/refs.rst @@ -0,0 +1,10 @@ +.. only:: html + + References + ---------- + +.. bibliography:: references.bib + :labelprefix: aa- + :keyprefix: aa- + + diff --git a/docs/source/user/aerodyn-aeroacoustics/symbols.rst b/docs/source/user/aerodyn-aeroacoustics/symbols.rst new file mode 100644 index 0000000000..794b2ab971 --- /dev/null +++ b/docs/source/user/aerodyn-aeroacoustics/symbols.rst @@ -0,0 +1,95 @@ +.. _AA-symbols: + +List of Symbols +--------------- + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{l}` + low frequency + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{h}` + high frequency + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{p}` + airfoil pressure side + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{s}` + airfoil suction side + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{t}` + turbulence + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{0}` + reference + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{1}` + parallel to airfoil chord + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{2}` + normal to airfoil chord + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{}_{3}` + blade spanwise direction + + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\alpha` + angle of attack + [rad] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\beta^{2}` + Prandtl-Glauert correction factor + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\delta` + airfoil boundary layer thickness + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\delta^{*}` + airfoil boundary layer displacement thickness + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\theta` + airfoil boundary layer momentum thickness + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\Theta_{e},\ \Phi_{e}` + angles between emitter and observer + [rad] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\rho` + air density + [kg/m\ :sup:`3`] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\omega` + radial frequency + [rad/s] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`A_{w}` + A-weight + [dB] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`c` + speed of sound + [m/s] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`c_{i}` + chord at blade spanwise position i + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`d` + blade span at station i + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\overline{D}` + directivity function + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`f` + frequency + [Hz] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`G` + empirical function + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`h` + height of the trailing edge thickness + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`H` + airfoil kinematic shape factor + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`I` + turbulence intensity + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`k` + wave number + [m\ :sup:`-1`] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\overline{k},\ \widehat{k}` + nondimensional wave number + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`{\mathrm{\Delta}K_{1},\ K}_{1}`,\ :math:`\ K_{2}` + empirical parameters of the BPM model + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`l` + spanwise extent of the separation zone from blade tip + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`L` + lift force + [N] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`L_{t}` + length scale + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`M` + Mach number + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`M_{c}` + Mach number past the trailing edge + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`r_{e}` + effective observer distance + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\text{Re}` + Reynolds number + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`S^{2}` + Sears function + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`\text{St}` + Strouhal number + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`t_{x}` + relative thickness of the airfoil at chordwise position x + [-] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`U` + local inflow velocity + [m/s] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`y` + blade spanwise position + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`z` + height above the ground + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ ++ :math:`z_{0}` + ground surface roughness + [m] + ++-----------------------------------------------------------+------------------------------------------------------------+-------------------+ + diff --git a/docs/source/user/aerodyn-olaf/Acknowledgments.txt b/docs/source/user/aerodyn-olaf/Acknowledgments.txt new file mode 100644 index 0000000000..3656506102 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/Acknowledgments.txt @@ -0,0 +1,19 @@ +.. _Acknowledgments: + +Acknowledgments +=============== + +This work was authored by the National Renewable Energy Laboratory, +operated by Alliance for Sustainable Energy, LLC, for the U.S. +Department of Energy (DOE) under Contract No. DE-AC36-08GO28308. Funding +provided by the U.S. Department of Energy Office of Energy Efficiency +and Renewable Energy Wind Energy Technologies Office. The views +expressed in the article do not necessarily represent the views of the +DOE or the U.S. Government. The U.S. Government retains and the +publisher, by accepting the article for publication, acknowledges that +the U.S. Government retains a nonexclusive, paid-up, irrevocable, +worldwide license to publish or reproduce the published form of this +work, or allow others to do so, for U.S. Government purposes. + +The authors are also grateful to the Big Adaptive Rotor program for +supporting the development of this software. diff --git a/docs/source/user/aerodyn-olaf/Acronyms.rst b/docs/source/user/aerodyn-olaf/Acronyms.rst new file mode 100644 index 0000000000..fb0d492fa6 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/Acronyms.rst @@ -0,0 +1,52 @@ +.. _Acronyms: + +List of Symbols +=============== + ++-----------------------------+---------------------------------------+ +| BEM | blade-element momentum | ++-----------------------------+---------------------------------------+ +| CFD | computational fluid dynamics | ++-----------------------------+---------------------------------------+ +| DOE | U.S. Department of Energy | ++-----------------------------+---------------------------------------+ +| :math:`F_v` | core radius factor | ++-----------------------------+---------------------------------------+ +| :math:`t` | time | ++-----------------------------+---------------------------------------+ +| FVW | free vortex wake | ++-----------------------------+---------------------------------------+ +| :math:`N` | number of rotor revolutions before | +| | wake cutoff condition | ++-----------------------------+---------------------------------------+ +| :math:`\vec{r}` | vector between point of interest and | +| | vortex segment | ++-----------------------------+---------------------------------------+ +| :math:`\vec{r}(\psi,\zeta)` | position vector of Lagrangian markers | ++-----------------------------+---------------------------------------+ +| :math:`r_c` | core radius | ++-----------------------------+---------------------------------------+ +| :math:`r_{c0}` | initial core radius | ++-----------------------------+---------------------------------------+ +| OLAF | cOnvecting LAgrangian Filaments | ++-----------------------------+---------------------------------------+ +| :math:`\alpha` | numerical constant :math:`=1.25643` | ++-----------------------------+---------------------------------------+ +| :math:`\Gamma` | circulation strength | ++-----------------------------+---------------------------------------+ +| :math:`\delta` | measure of viscous diffusion | ++-----------------------------+---------------------------------------+ +| :math:`\epsilon` | measure of strain | ++-----------------------------+---------------------------------------+ +| :math:`\Delta \psi` | step size for blade rotation | ++-----------------------------+---------------------------------------+ +| :math:`\Omega` | rotational speed of wind turbine | ++-----------------------------+---------------------------------------+ +| :math:`\zeta` | vortex wake age | ++-----------------------------+---------------------------------------+ +| :math:`\zeta_0` | vortex wake age offset | ++-----------------------------+---------------------------------------+ +| :math:`\nu` | kinematic viscosity | ++-----------------------------+---------------------------------------+ +| :math:`\psi` | azimuth blade position | ++-----------------------------+---------------------------------------+ diff --git a/docs/source/user/aerodyn-olaf/AppendixA.rst b/docs/source/user/aerodyn-olaf/AppendixA.rst new file mode 100644 index 0000000000..a350de1517 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/AppendixA.rst @@ -0,0 +1,14 @@ +.. _OLAF-Primary-Input-File: + +Appendix A: OLAF Primary Input File +=================================== + + +**Check the regression test cases for updates to this input file.** + +.. container:: + :name: Tab:OLAFinputfile + + .. literalinclude:: ExampleFiles/ExampleFile--OLAF.txt + :linenos: + :language: none diff --git a/docs/source/user/aerodyn-olaf/AppendixB.rst b/docs/source/user/aerodyn-olaf/AppendixB.rst new file mode 100644 index 0000000000..952d75c571 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/AppendixB.rst @@ -0,0 +1,13 @@ +.. _Prescribed-Circulation-Input-File: + +Appendix B: Prescribed Circulation Input File +============================================= + +**Check the regression tests for updated versions of this file.** + +.. container:: + :name: TabPrescribeCirc + + .. literalinclude:: ExampleFiles/ExampleFile--PrescribeCirc.txt + :linenos: + :language: none diff --git a/docs/source/user/aerodyn-olaf/AppendixC.rst b/docs/source/user/aerodyn-olaf/AppendixC.rst new file mode 100644 index 0000000000..66613d90b7 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/AppendixC.rst @@ -0,0 +1,35 @@ +.. _OLAF-List-of-Output-Channels: + +Appendix C: OLAF List of Output Channels +======================================== + +This is a list of all possible output parameters from the OLAF module. +The names are grouped by meaning, but can be ordered in the OUTPUTS +section of the *AeroDyn15* primary input file, as the user sees fit. +:math:`N\beta` refers to output node, :math:`\beta`, where :math:`\beta` +is a number in the range [1,9], corresponding to entry, :math:`\beta`, +in the **OutNd** list. :math:`B\alpha` is prefixed to each output name, +where :math:`\alpha` is a number in the range [1,3], corresponding to +the blade number. + + +.. list-table:: Available OLAF Output Channels + :widths: 25 15 50 + :header-rows: 1 + :align: center + :name: Tab:OLAFoutputs + + * - Channel Name(s) + - Units + - Description + * - :math:`B \alpha N \beta Gam` + - :math:`m^2/s` + - Circulation along the blade + + +.. + ============================ ============= =========================== + Channel Name(s) Units Description + ============================ ============= =========================== + :math:`B \alpha N \beta Gam` :math:`m^2/s` Circulation along the blade + ============================ ============= =========================== diff --git a/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt b/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt new file mode 100644 index 0000000000..e0d341697f --- /dev/null +++ b/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt @@ -0,0 +1,42 @@ +--------------------------- OLAF (cOnvecting LAgrangian Filaments) INPUT FILE ----------------- +Free wake input file for the Helix test case +--------------------------- GENERAL OPTIONS --------------------------------------------------- +5 IntMethod Integration method {5: Forward Euler 1st order, default: 5} (switch) +0.2 DTfvw Time interval for wake propagation. {default: dtaero} (s) +5 FreeWakeStart Time when wake is free. (-) value = always free. {default: 0.0} (s) +2.0 FullCircStart Time at which full circulation is reached. {default: 0.0} (s) +--------------------------- CIRCULATION SPECIFICATIONS ---------------------------------------- +1 CircSolvingMethod Circulation solving method {1: Cl-Based, 2: No-Flow Through, 3: Prescribed, default: 1 }(switch) +0.01 CircSolvConvCrit Convergence criteria {default: 0.001} [only if CircSolvingMethod=1] (-) +0.1 CircSolvRelaxation Relaxation factor {default: 0.1} [only if CircSolvingMethod=1] (-) +30 CircSolvMaxIter Maximum number of iterations for circulation solving {default: 30} (-) + "NA" PrescribedCircFile File containing prescribed circulation [only if CircSolvingMethod=3] (quoted string) +=============================================================================================== +--------------------------- WAKE OPTIONS ------------------------------------------------------ +------------------- WAKE EXTENT AND DISCRETIZATION -------------------------------------------- +50 nNWPanel Number of near-wake panels [integer] (-) +400 WakeLength Total wake distance [integer] (number of time steps) +default FreeWakeLength Wake length that is free [integer] (number of time steps) {default: WakeLength} +False FWShedVorticity Include shed vorticity in the far wake {default: false} +------------------- WAKE REGULARIZATIONS AND DIFFUSION ----------------------------------------- +0 DiffusionMethod Diffusion method to account for viscous effects {0: None, 1: Core Spreading, "default": 0} +0 RegDeterMethod Method to determine the regularization parameters {0: Manual, 1: Optimized, default: 0 } +2 RegFunction Viscous diffusion function {0: None, 1: Rankine, 2: LambOseen, 3: Vatistas, 4: Denominator, "default": 3} (switch) +0 WakeRegMethod Wake regularization method {1: Constant, 2: Stretching, 3: Age, default: 1} (switch) +2.0 WakeRegFactor Wake regularization factor (m) +2.0 WingRegFactor Wing regularization factor (m) +100 CoreSpreadEddyVisc Eddy viscosity in core spreading methods, typical values 1-1000 +------------------- WAKE TREATMENT OPTIONS --------------------------------------------------- +False TwrShadowOnWake Include tower flow disturbance effects on wake convection {default:false} [only if TwrPotent or TwrShadow] +0 ShearModel Shear Model {0: No treatment, 1: Mirrored vorticity, default: 0} +------------------- SPEEDUP OPTIONS ----------------------------------------------------------- +2 VelocityMethod Method to determine the velocity {1:Biot-Savart Segment, 2:Particle tree, default: 1} +1.5 TreeBranchFactor Branch radius fraction above which a multipole calculation is used {default: 2.0} [only if VelocityMethod=2] +1 PartPerSegment Number of particles per segment [only if VelocityMethod=2] +=============================================================================================== +--------------------------- OUTPUT OPTIONS --------------------------------------------------- +1 WrVTk Outputs Visualization Toolkit (VTK) (independent of .fst option) {0: NoVTK, 1: Write VTK at each time step} (flag) +1 nVTKBlades Number of blades for which VTK files are exported {0: No VTK per blade, n: VTK for blade 1 to n} (-) +2 VTKCoord Coordinate system used for VTK export. {1: Global, 2: Hub, "default": 1} +1 VTK_fps Frame rate for VTK output (frames per second) {"all" for all glue code timesteps, "default" for all OLAF timesteps} [used only if WrVTK=1] +------------------------------------------------------------------------------------------------ diff --git a/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--PrescribeCirc.txt b/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--PrescribeCirc.txt new file mode 100644 index 0000000000..b174db2ca0 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--PrescribeCirc.txt @@ -0,0 +1,26 @@ +r/R [-], Gamma [m^2/s] +0.048488, 0.000000 +0.087326, 0.442312 +0.126163, 6.909277 +0.165000, 23.678557 +0.203837, 55.650700 +0.242674, 74.091529 +0.281512, 84.205843 +0.320349, 88.740429 +0.359186, 89.730814 +0.398023, 88.568114 +0.436860, 87.114743 +0.475698, 86.110557 +0.514535, 85.705529 +0.553372, 85.215829 +0.592209, 84.547371 +0.631047, 83.774329 +0.669884, 82.889157 +0.708721, 81.635600 +0.747558, 79.788700 +0.786395, 77.195200 +0.825233, 73.765100 +0.864070, 69.275900 +0.902907, 62.965400 +0.941744, 53.603300 +0.980581, 39.854000 diff --git a/docs/source/user/aerodyn-olaf/FutureWork.rst b/docs/source/user/aerodyn-olaf/FutureWork.rst new file mode 100644 index 0000000000..f755317574 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/FutureWork.rst @@ -0,0 +1,31 @@ +.. _Future-Work: + +Future Work +=========== + +This first implementation phase focused on single-turbine capabilities, +fulfilling the basic requirements for the design of large and novel +rotor concepts. Future development work will turn toward the +implementation of features enabling multiple-turbine simulations on +medium-to-large-scale computational clusters. The reduction of the +computational time will also be of focus. This may be achieved using +tree techniques such as the fast multipole method. Further algorithmic +options, such as vortex amalgamation in the far wake, will be considered +to speed up the simulation. The framework presented in this manual is +compatible with grid-free or grid-based vortex particle formulations. +Such particle-based implementations will also be envisaged in the +future. Further validation of the code against measurements and +higher-order tools will be pursued. Applications to cases known to be +challenging for the BEM algorithm will also be investigated, such as +highly flexible rotors, offshore floating turbines, small-scale wind +farms, multiple-rotor turbines, or kites. + +The following list contains future work on OLAF software: + +- Lagrangian particles + +- Multiple turbines, integration into FAST.Farm + +- Code speed-up + +- Dedicated dynamic stall model diff --git a/docs/source/user/aerodyn-olaf/InputFiles.rst b/docs/source/user/aerodyn-olaf/InputFiles.rst new file mode 100644 index 0000000000..16de76bff6 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/InputFiles.rst @@ -0,0 +1,239 @@ +.. _OLAF-Input-Files: + +Input Files +=========== + +No lines should be added or removed from the input files, except in tables where +the number of rows is specified. + +Units +----- + +OLAF uses the International System of Units (e.g., kg, m, s, N). Angles are +assumed to be in degrees unless otherwise specified. + +OLAF Primary Input File +----------------------- + +The primary OLAF input file defines general free wake options, circulation model +selection and specification, near- and far-wake length, and wake visualization +options. Each section within the file corresponds to an aspect of the OLAF model. For most parameters, the user may +specify the value "default" (with or without quotes), in which case a default +value, defined below, is used by the program. + +See :numref:`OLAF-Primary-Input-File` for a sample OLAF primary input file. + +General Options +~~~~~~~~~~~~~~~ + +**IntMethod** [switch] specifies which integration method will be used to +convect the Lagrangian markers. There are four options: 1) fourth-order +Runge-Kutta *[1]*, 2) fourth-order Adams-Bashforth *[2]*, 3) fourth-order +Adams-Bashforth-Moulton *[3]*, and 4) first-order forward Euler *[5]*. The +default option is *[5]*. These methods are specified in :numref:`sec:vortconv`. + +**DTfvw** [sec] specifies the time interval at which the module will update the +wake. The time interval must be a multiple of the time step used by +*AeroDyn15*. The blade circulation is updated at each intermediate time +step based on the intermediate blades positions and wind velocities. The default +value is :math:`dt_{aero}`, where :math:`dt_{aero}` is the time step used by +AeroDyn. + +**FreeWakeStart** [sec] specifies at what time the wake evolution is classified +as “free." Before this point is reached, the Lagrangian markers are simply +convected with the freestream velocity. After this point, induced velocities are +computed and affect the marker convection. If a time less than or equal to zero +is given, the wake is “free" from the beginning of the simulation. The default +value is :math:`0`. + +**FullCircStart** [sec] specifies at what time the blade circulation reaches its +full strength. If this value is specified to be :math:`>0`, the circulation is +multiplied by a factor of :math:`0` at :math:`t=0` and linearly increasing to a +factor of :math:`1` for :math:`t>\textit{FullCircStart}`. The default +value is :math:`0`. + +Circulation Specifications +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**CircSolvMethod** [switch] specifies which circulation method is used. There +are three options: 1) :math:`C_l`-based iterative procedure *[1]*, 2) no-flow +through *[2]*, and 3) prescribed *[3]*. The default option is *[1]*. These +methods are described in :numref:`sec:circ`. + +**CircSolvConvCrit** [-] specifies the dimensionless convergence criteria used +for solving the circulation. This variable is only used if +*CircSolvMethod* = *[1]*. The default value is +:math:`0.001`, corresponding to :math:`0.1\%` error in the circulation between +two iterations. + +**CircSolvRelaxation** [-] specifies the relaxation factor used to solve the +circulation. This variable is only used if *CircSolvMethod* = +*[1]*. The default value is :math:`0.1`. + +**CircSolvMaxIter** [-] specifies the maximum number of iterations used to solve +the circulation. This variable is only used if *CircSolvMethod* = *[1]*. The +default value is :math:`30`. + +**PrescribedCircFile** [quoted string] specifies the file containing the +prescribed blade circulation. This option is only used if *CircSolvMethod* = +*[3]*. The circulation file format is a delimited file with one header line and +two columns. The first column is the dimensionless radial position [r/R]; the +second column is the bound circulation value in [m\ :math:`^2`/s]. The radial +positions do not need to match the AeroDyn node locations. A sample prescribed +circulation file is given in :numref:`Prescribed-Circulation-Input-File`. + + +Wake Extent and Discretization Options +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**nNWPanel** [-] specifies the number of FVW time steps (**DTfvw**) for which +the near-wake lattice is computed. In the future, this value will be defined as +an azimuthal span in degrees or a downstream distance in rotor diameter. + +**WakeLength** [D] specifies the length, in rotor diameters, of the far wake. +The default value is :math:`8`. [1]_ + +**FreeWakeLength** [D] specifies the length, in rotor diameters, for which the +turbine wake is convected as “free." If *FreeWakeLength* is greater than +*WakeLength*, then the entire wake is free. Otherwise, the Lagrangian markers +located within the buffer zone delimited by *FreeWakeLength* and *WakeLength* +are convected with the average velocity. The default value is :math:`6`. [2]_ + +**FWShedVorticity** [flag] specifies whether shed vorticity is included in the +far wake. The default value is *[False]*, specifying that the far wake consists +only of the trailed vorticity from the root and tip vortices. + +Wake Regularization and Diffusion Options +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**DiffusionMethod** [switch] specifies which diffusion method is used to account +for viscous diffusion. There are two options: 1) no diffusion *[0]* and 2) the +core-spreading method *[1]*. The default option is *[0]*. + +**RegDetMethod** [switch] specifies which method is used to determine the +regularization parameters. There are two options: 1) manual *[0]* and 2) +optimized *[1]*. The manual option requires the user to specify the parameters +listed in this subsection. The optimized option determines the parameters for +the user. The default option is *[0]*. + +**RegFunction** [switch] specifies the regularization function used to remove +the singularity of the vortex elements, as specified in +:numref:`sec:vortconv`. There are five options: 1) no correction *[0]*, +2) the Rankine method *[1]*, 3) the Lamb-Oseen method *[2]*, 4) the Vatistas +method *[3]*, and 5) the denominator offset method *[4]*. The functions are +given in . The default option is *[3]*. + +**WakeRegMethod** [switch] specifies the method of determining viscous core +radius (i.e., the regularization parameter). There are three options: 1) +constant *[1]*, 2) stretching *[2]*, and 3) age *[3]*. The methods are +described in :numref:`sec:corerad`. The default option is *[1]*. + +**WakeRegParam** [m] specifies the wake regularization parameter, which is the +regularization value used at the initialization of a vortex element. If the +regularization method is “constant”, this value is used throughout the wake. + +**BladeRegParam** [m] specifies the bound vorticity regularization parameter, +which is the regularization value used for the vorticity elements bound to the +blades. + +**CoreSpreadEddyVisc** [-] specifies the eddy viscosity parameter +:math:`\delta`. The parameter is used for the core-spreading method +(*DiffusionMethod* = *[1]*) and the regularization method with age +(*WakeRegMethod* = *[3]*). The variable :math:`\delta` is described in +:numref:`sec:corerad`. The default value is :math:`100`. + +Wake Treatment Options +~~~~~~~~~~~~~~~~~~~~~~ + +**TwrShadowOnWake** [flag] specifies whether the tower potential flow and tower +shadow have an influence on the wake convection. The tower shadow model, when +activated in AeroDyn, always has an influence on the lifting line, hence the +induction and loads on the blade. This option only concerns the wake. The +default option is *[False]*. + +**ShearVorticityModel** [switch] specifies whether shear vorticity is modeled in +addition to the sheared inflow prescribed by *InflowWind*. There are two +options: 1) no treatment *[0]* and 2) mirrored vorticity *[1]*. The mirrored +vorticity accounts for the ground effect. Dedicated options to account for the +shear vorticity will be implemented at a later time. The shear velocity profile +is handled by *InflowWind* irrespective of this input. The default option is +*[0]*. + + +Speedup Options +~~~~~~~~~~~~~~~ + +**VelocityMethod** [switch] specifies the method used to determine the velocity. +There are two options: 1) Biot-Savart law applied to the vortex segments *[1]* +and 2) tree formulation using a particle representation *[2]*. The default +option is *[1]*. + +**TreeBranchFactor** [-] specifies the dimensionless distance, in branch radius, +above which a multipole calculation is used instead of a direct evaluation. This +option is only used in conjunction with the tree code +(*VelocityMethod* = *[2]*). + +**PartPerSegment** [-] specifies the number of particles that are used when a +vortex segment is represented by vortex particles. The default value is +:math:`1`. + +Output Options +~~~~~~~~~~~~~~ + +**WrVTK** [flag] specifies if Visualization Toolkit (VTK) visualization files +are to be written out. *WrVTK* = *[0]* does not write out any VTK files. *WrVTK* += *[1]* outputs a VTK file at every time step. The outputs are written in the +folder, ``vtk_fvw.`` The parameters *WrVTK*, *VTKCoord*, and *VTK_fps* are +independent of the glue code VTK output options. + + +**VTKBlades** [-] specifies how many blade VTK files are to be written out. +*VTKBlades* :math:`= n` outputs VTK files for :math:`n` blades, with :math:`0` +being an acceptable value. The default value is :math:`1`. + +**VTKCoord** [switch] specifies in which coordinate system the VTK files are +written. There are two options: 1) global coordinate system *[1]* and 2) hub +coordinate system *[2]*. The default option is *[1]*. + +**VTK_fps** [:math:`1`/sec] specifies the output frequency of the VTK files. The +provided value is rounded to the nearest allowable multiple of the time step. +The default value is :math:`1/dt_\text{fvw}`. Specifying *VTK_fps* = *[all]*, +is equivalent to using the value :math:`1/dt_\text{aero}`. + +AeroDyn15 Input File +-------------------- +Input file modifications +~~~~~~~~~~~~~~~~~~~~~~~~ + +As OLAF is incorporated into the *AeroDyn15* module, a wake computation option +has been added to the *AeroDyn15* input file and a line has been added. These +additions are as follows. + +**WakeMod** specifies the type of wake model that is used. *WakeMod* = *[3]* has +been added to allow the user to switch from the traditional BEM method to the +OLAF method. + +**FVWFile** [string] specifies the OLAF module file, the path is relative to the +AeroDyn file, unless an absolute path is provided. + + +Relevant sections +~~~~~~~~~~~~~~~~~ +The BEM options (e.g. tip-loss, skew, and dynamic models) are read and discarded +when *WakeMod* = *[3]*. The following sections and parameters remain relevant and +are used by the vortex code: + + - general options (e.g., airfoil and tower modeling); + - environmental conditions; + - dynamic stall model options; + - airfoil and blade information; + - tower aerodynamics; and + - outputs. + +.. [1] + At present, this variable is called nFWPanel and specified as the number of far + wake panels. This will be changed soon. + +.. [2] + At present, this variable is called nFWPanelFree and specified as the number of + free far wake panels. This will be changed soon. diff --git a/docs/source/user/aerodyn-olaf/Introduction.rst b/docs/source/user/aerodyn-olaf/Introduction.rst new file mode 100644 index 0000000000..00fc2b1014 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/Introduction.rst @@ -0,0 +1,156 @@ +.. _Introduction: + +Introduction +============ +Over the past few decades, substantial reductions in the cost of wind energy +have come from large increases in rotor size. One important consideration for +such large turbines is increased blade flexibility. In particular, large blade +deflections may lead to a swept area that deviates significantly from the rotor +plane. Such deviations violate assumptions used by common aerodynamic models, +such as the blade element momentum (BEM) method. Such methods rely on +actuator-disk assumptions that are only valid for axisymmetric rotor loads +contained in a plane. Large blade deflections may also cause near wake of the +turbine to diverge from a uniform helical shape. Further, interactions between +turbine blades and the local near wake may increase, thus violating assumptions +of models that do not account for the position and dynamics of the near wake. +Additionally, highly flexible blades will likely cause increased unsteadiness +and three-dimensionality of aerodynamic effects, increasing the importance of +accurate and robust dynamic stall models. There are many other complex wind +turbine situations that violate simple engineering assumptions. Such situations +include obtaining accurate aerodynamic loads for nonstraight blade geometries +(e.g., built-in curvature or sweep); skewed flow caused by yawed inflow or +turbine tilt; and large rotor motion as a result of placing the turbine atop a +compliant offshore floating platform. + +Higher-fidelity aerodynamic models are necessary to account for the increased +complexity of flexible and floating rotors. Although computational fluid +dynamics (CFD) methods are able to capture such features, their computational +cost limits the number of simulations that can be feasibly performed, which is +an important consideration in load analysis for turbine design. FVW methods are +less computationally expensive than CFD methods while modeling similarly complex +physics. As opposed to the BEM methods, FVW methods do not rely on ad-hoc +engineering models to account for dynamic inflow, skewed wake, tip losses, or +ground effects. These effects are inherently part of the model. Numerous +vorticity-based tools have been implemented, ranging from the early treatments +by Rosenhead (:cite:`olaf-Rosenhead31_1`), the formulation of vortex particle methods +by Winckelmans and Leonard (:cite:`olaf-Winckelmans93_1`), to the recent mixed +Eulerian-Lagrangian compressible formulations of +Papadakis (:cite:`olaf-Papadakis14_1`). Examples of long-standing codes that have been +applied in the field of wind energy are GENUVP (:cite:`olaf-Voutsinas06_1`), using +vortex particles methods, and AWSM (:cite:`olaf-Garrel03_1`), using vortex filament +methods. Both tools have successfully been coupled to structural solvers. The +method was extended by Branlard et al. (:cite:`olaf-Branlard15_1`) to consistently use +vortex methods to perform aero-elastic simulations of wind turbines in sheared +and turbulent inflow. Most formulations rely on a lifting-line representation of +the blades, but recently, a viscous-inviscid representation was used in +combination with a structural solver (:cite:`olaf-Miras17_1`). + +cOnvecting LAgrangian Filaments (OLAF) is a free vortex wake (FVW) module used +to compute the aerodynamic forces on moving two- or three-bladed horizontal-axis +wind turbines. This module has been incorporated into the National Renewable +Energy Laboratory physics-based engineering tool, OpenFAST, which solves the +aero-hydro-servo-elastic dynamics of individual wind turbines. OLAF is +incorporated into the OpenFAST module, *AeroDyn15*, as an alternative to the +traditional blade-element momentum (BEM) option, as shown in +Figures :numref:`figOpenFAST_a` and :numref:`figOpenFAST_b`. + +.. _figOpenFAST_a: + +.. figure:: Schematics/OpenFAST.png + :alt: OpenFAST schematic + :width: 100% + :align: center + + OpenFAST schematic + +.. _figOpenFAST_b: + +.. figure:: Schematics/FVWwithOpenFAST.png + :alt: OpenFAST overview schematic and OLAF integration + :width: 100% + :align: center + + OLAF and BEM integration with *AeroDyn15* + +Incorporating the OLAF module within OpenFAST allows for the modeling of +highly flexible turbines along with the aero-hydro-servo-elastic +response capabilities of OpenFAST. The OLAF module follows the +requirements of the OpenFAST modularization framework  +(:cite:`olaf-Sprague15_1,olaf-Jonkman13_1`). + +The OLAF module uses a lifting-line representation of the blades, which +is characterized by a distribution of bound circulation. The spatial and +time variation of the bound circulation results in free vorticity being +emitted in the wake. OLAF solves for the turbine wake in a time-accurate +manner, which allows the vortices to convect, stretch, and diffuse. The +OLAF model is based on a Lagrangian approach, in which the turbine wake +is discretized into Lagrangian markers. There are many methods of +representing the wake with Lagrangian +markers (:cite:`olaf-Branlard17_1`). In this work, a hybrid +lattice/filament method is used, as depicted in +Figure :numref:`Lagrangian`. + +.. figure:: Schematics/LagrangianMarkers.png + :alt: Evolution of near-wake lattice, blade-tip vortex, and Lagrangian markers + :name: Lagrangian + :width: 100% + :align: center + + Evolution of near-wake lattice, blade-tip vortex, and Lagrangian + markers + +Here, the position of the Lagrangian markers is defined in terms of wake +age, :math:`\zeta`, and azimuthal position, :math:`\psi`. A lattice +method is used in the near wake of the blade. The near wake spans over a +user-specified angle or distance for nonrotating cases. Though past +research has indicated that a near-wake region of :math:`30^\circ` is +sufficient (:cite:`olaf-Leishman_book,olaf-Ananthan02_1`), it has been shown that a larger +near wake is required for high thrust and other challenging conditions. After +the near wake region, the wake is assumed to instantaneously roll up into a tip +vortex and a root vortex, which are assumed to be the most dominant features for +the remainder of the wake (:cite:`olaf-Leishman02_1`). Each Lagrangian marker is +connected to adjacent markers by straight-line vortex filaments, approximated to +second-order accuracy (:cite:`olaf-Gupta05_1`). The wake is discretized based on the +spanwise location of the blade sections and a specified time step (:math:`dt`), +which may be different from the time step of AeroDyn. After an optional +initialization period, the wake is allowed to move and distort, thus changing +the wake structure as the markers are convected downstream. To limit +computational expense, the root and tip vortices are truncated after a specified +distance (**WakeLength**) downstream from the turbine. The wake truncation +violates Helmholtz's first law and hence introduces an erroneous boundary +condition. To alleviate this, the wake is "frozen" in a buffer zone between a +specified buffer distance, **FreeWakeLength**, and **WakeLength**. In this +buffer zone, the markers convect at the average ambient velocity. In this way, +truncation error is minimized~(:cite:`olaf-Leishman02_1`). The buffer zone is +typically chosen as the convected distance over one rotor revolution. + +As part of OpenFAST, induced velocities at the lifting line/blade are +transferred to *AeroDyn15* and used to compute the effective blade angle of +attack at each blade section, which is then used to compute the aerodynamic +forces on the blades. The OLAF method returns the same information as the BEM +method, but allows for more accurate calculations in areas where BEM assumptions +are violated, such as those discussed above. As the OLAF method is more +computationally expensive than BEM, both methods remain available in OpenFAST, +and the user may specify in the *AeroDyn15* input file which method is +used. + +The OLAF input file defines the wake convection and circulation solution +methods; wake size and length options; Lagrangian marker regularization (viscous +core) method; and other simulation and output parameters. The extents of the +near and far wakes are specified by a nondimensional length in terms of rotor +diameter. Different regularization functions for the vortex elements are +available. Additionally, different methods to compute the regularization +parameters of the bound and wake vorticity may be selected. In particular, +viscous diffusion may be accounted for by dynamically changing the +regularization parameter. Wake visualization output options are also available. + +This document is organized as follows. :numref:`Running-OLAF` covers +downloading, compiling, and running OLAF. :numref:`OLAF-Input-Files` describes the +OLAF input file and modifications to the *AeroDyn15* input file. +:numref:`Output-Files` details the OLAF output file. :numref:`OLAF-Theory` +provides an overview of the OLAF theory, including the free vortex wake method +as well as integration into the *AeroDyn15* module. Example input files and a +list of output channels are detailed in Appendices A, B, and C. + + + diff --git a/docs/source/user/aerodyn-olaf/OLAFTheory.rst b/docs/source/user/aerodyn-olaf/OLAFTheory.rst new file mode 100644 index 0000000000..0c901f2b3a --- /dev/null +++ b/docs/source/user/aerodyn-olaf/OLAFTheory.rst @@ -0,0 +1,628 @@ +.. _OLAF-Theory: + +OLAF Theory +=========== + +This section details the OLAF method and provides an overview of the +computational method, followed by a brief explanation of its integration +with OpenFAST. + + +.. _sec:vorticityformulation: + +Introduction - Vorticity Formulation +------------------------------------ + +The vorticity equation for incompressible homogeneous flows in the +absence of non-conservative force is given by +Eq. :eq:`eq:vorticityconservationincompr` + +.. math:: + \begin{aligned} + \frac{d\vec{\omega}}{dt} = \frac{\partial\vec{\omega}}{\partial{t}} + \underbrace{(\vec{u} \cdot \nabla)}_{\text{convection}}\vec{\omega} = \underbrace{(\vec{\omega}\cdot\nabla)\vec{u}}_{\text{strain}} +\underbrace{\nu\Delta\vec{\omega}}_{\text{diffusion}} + \end{aligned} + :label: eq:vorticityconservationincompr + + +Here, :math:`\vec{\omega}` is the vorticity, :math:`\vec{u}` is the +velocity, and :math:`\nu` is the viscosity. In free vortex wake methods, +the vorticity equation is used to describe the evolution of the wake +vorticity. Different approximations are introduced to ease its +resolution, such as projecting the vorticity onto a discrete number of +vortex elements (here vortex filaments), and separately treating the +convection and diffusion steps, known as viscous-splitting. Several +complications arise from the method; in particular, the discretization +requires a regularization of the vorticity field (or velocity field) to +ensure a smooth approximation. + +The forces exerted by the blades onto the flow are expressed in +vorticity formulation as well. This vorticity is bound to the blade and +has a circulation associated with the lift force. A lifting-line +formulation is used here to model the bound vorticity. + +The different models of the implemented free vortex code are described +in the following sections. + +.. _sec:discretization: + +Discretization - Projection +--------------------------- + +The numerical method uses a finite number of states to model the +continuous vorticity distribution. To achieve this, the vorticity +distribution is projected onto basis function which is referred to +as vortex elements. Vortex filaments are here used as elements that +represents the vorticity field. A vortex filament is delimited by two +points and hence assumes a direction formed by these two points. A +vorticity tube is oriented along the unit vector :math:`\vec{e}_x` of +cross section :math:`dS` and length :math:`l`. It can then be +approximated by a vortex filament of length :math:`l` oriented along the +same direction. The total vorticity of the tube and the vortex filaments +are the same and related by: + +.. math:: + \begin{aligned} + \vec{\omega} \, dS = \vec{\Gamma} + \end{aligned} + :label: OmegaGamma + +where :math:`\vec{\Gamma}` is the circulation intensity of the vortex +filament. If the vorticity tubes are complex and occupy a large volume, +the projection onto vortex filaments is difficult and the projection +onto vortex particle is more appropriate. Assuming the wake is confined +to a thin vorticity layer which defines a velocity jump of know +direction, it is possible to approximate the wake vorticity sheet as a +mesh of vortex filaments. This is the basis of vortex filament wake +methods. Vortex filaments are a singular representation of the vorticity +field, as they occupy a line instead of a volume. To better represent +the vorticity field, the filaments are “inflated”, a process referred to +as regularization (see :numref:`sec:Regularization`). The +regularization of the vorticity field also regularizes the velocity +field and avoids the singularities that would otherwise occur. + + +.. _sec:circ: + +Lifting-Line Representation +--------------------------- + +The code relies on a lifting-line formulation. Lifting-line methods effectively +lump the loads at each cross-section of the blade onto the mean line of the +blade and do not account directly for the geometry of each cross-section. In the +vorticity-based version of the lifting-line method, the blade is represented by +a line of varying circulation. The line follows the motion of the blade and is +referred to as “bound” circulation. The bound circulation does not follow the +same dynamic equation as the free vorticity of the wake. Instead, the intensity +is linked to airfoil lift via the Kutta-Joukowski theorem. Spanwise variation of +the bound circulation results in vorticity being emitted into the the wake. This +is referred to as “trailed vorticity”. Time changes of the bound circulation are +also emitted in the wake, referred to as “shed” vorticity. The subsequent +paragraphs describe the representation of the bound vorticity. + +Lifting-Line Panels and Emitted Wake Panels +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The lifting-line and wake representation is illustrated in +:numref:`fig:VortexLatticeMethod`. The blade lifting-line is discretized into a +finite number of panels, each of them forming a four sided vortex rings. The +spanwise discretization follows the discretization of the AeroDyn blade input +file. The number of spanwise panels, :math:`n_\text{LL}`, is one less than the +total number of AeroDyn nodes, **NumBlNds**. The sides of the panels coincide +with the lifting-line and the trailing edge of the blade. The lifting-line is +currently defined as the 1/4 chord location from the leading edge (LE). More +details on the panelling is provided in :numref:`sec:Panelling`. At a given time +step, the circulation of each lifting-line panel is determined according to one +of the three methods developed in :numref:`sec:CirculationMethods`. At the end +of the time step, the circulation of each lifting-line panel is emitted into the +wake, forming free vorticity panels. To satisfy the Kutta condition, the +circulation of the first near wake panel and the bound circulation are +equivalent (see :numref:`fig:VortexLatticeMethod` b). The wake panels model the +thin shear layer resulting from the continuation of the blade boundary layer. +This shear layer can be modelled using a continuous distribution of vortex +doublets. A constant doublet strength is assumed on each panel, which in turn is +equivalent to a vortex ring of constant circulation. + +.. figure:: Schematics/VortexLatticeMethod.png + :alt: Wake and lifting-line vorticity discretized into vortex ring panels. + :name: fig:VortexLatticeMethod + :width: 100.0% + + Wake and lifting-line vorticity discretized into vortex ring panels. + (a) Overview. (b) Cross-sectional view, defining the leading-edge, + trailing edge, and lifting-line. (c) Circulation of panels and + corresponding circulation for vorticity segments between panels. (d) + Geometrical quantities for a lifting-line panel. + +The current implementation stores the positions and circulations of the panel +corner points. In the vortex ring formulation, the boundary between two panels +corresponds to a vortex segment of intensity equal to the difference of +circulation between the two panels. The convention used to define the segment +intensity based on the panels intensity is shown in +:numref:`fig:VortexLatticeMethod` c. Since the circulation of the bound panels +and the first row of near wake panels are equal, the vortex segments located on +the trailing edge have no circulation. + +.. _sec:Panelling: + +Panelling +~~~~~~~~~ + +The definitions used for the panelling of the blade are given in +:numref:`fig:VortexLatticeMethod` d, following the notations of van +Garrel (:cite:`olaf-Garrel03_1`). The leading edge and +trailing edge (TE) locations are directly obtained from the AeroDyn +mesh. At two spanwise locations, the LE and TE define the corner points: +:math:`\vec{x}_1`, :math:`\vec{x}_2`, :math:`\vec{x}_3`, and +:math:`\vec{x}_4`. The current implementation assumes that the +aerodynamic center, the lifting-line, and the 1/4 chord location all +coincide. For a given panel, the lifting-line is then delimited by the +points :math:`\vec{x}_9= 3/4\,\vec{x}_1 + 1/4\, \vec{x}_2` and +:math:`\vec{x}_{10}=3/4\,\vec{x}_4 + 1/4\, \vec{x}_3`. The mid points of +the four panel sides are noted :math:`\vec{x}_5`, :math:`\vec{x}_6`, +:math:`\vec{x}_7`, and :math:`\vec{x}_8`. The lifting-line vector +(:math:`\vec{dl}`) as well as the vectors tangential (:math:`\vec{T}`) +and normal (:math:`\vec{N}`) to the panel are defined as: + +.. math:: + \begin{aligned} + \vec{dl} = \vec{x}_{10}-\vec{x}_9 + ,\qquad + \vec{T} = \frac{\vec{x}_6-\vec{x}_8}{|\vec{x}_6-\vec{x}_8|} + ,\qquad + \vec{N} = \frac{\vec{T}\times\vec{dl}}{|\vec{T}\times\vec{dl}|} + \end{aligned} + :label: eq:GeometricDefinitions + +The area of the panel is obtained as :math:`dA = +|(\vec{x}_6-\vec{x}_8)\times(\vec{x}_{7}-\vec{x}_5)|`. For +**CircSolvMethod=[1]**, the control points are located on the lifting-line at +the location :math:`\vec{x}_9+\eta_j \vec{dl}`. The factor :math:`\eta_j` is +determined based on the full-cosine approximation of van Garrel. This is based +on the spanwise widths of the current panel, :math:`w_j`, and the neighboring +panels :math:`w_{j-1}` and :math:`w_{j+1}`: + +.. math:: + \begin{aligned} + \eta_1 &= \frac{w_1}{w_1+w_2},\\ + \eta_j &= \frac{1}{4}\left[\frac{w_{j-1}}{w_{j-1}+w_j} + \frac{w_j}{w_j+w_{j+1}} +1 \right] + ,\ j=2..n-1,\\ + \eta_{n} &= \frac{w_{n-1}}{w_{n-1}+w_{n}} + \end{aligned} + +For an equidistant spacing, this discretization places the control points at the +middle of the lifting-line (:math:`\eta=0.5`). Theoretical circulation results +for an elliptic wing with a cosine spacing are retrieved with such +discretization since it places the control points closer to stronger trailing +segments at the wing extremities (see e.g. :cite:`olaf-Kerwin:lecturenotes`). + +.. _sec:CirculationMethods: + +Circulation Solving Methods +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Three methods are implemented to determine the bound circulation strength. They +are selected using the input **CircSolvMethod**, and are presented in the +following sections. + +Cl-Based Iterative Method +^^^^^^^^^^^^^^^^^^^^^^^^^ + +The Cl-based iterative method determines the circulation within a +nonlinear iterative solver that makes use of the polar data at each +control point located on the lifting line. The algorithm ensures that +the lift obtained using the angle of attack and the polar data matches +the lift obtained with the Kutta-Joukowski theorem. At present, it is +the preferred method to compute the circulation along the blade span. It is +selected with **CircSolvMethod=[1]**. The method is described in the work from +van Garrel (:cite:`olaf-Garrel03_1`). The algorithm is implemented in at iterative +approach using the following steps: + +#. The circulation distribution from the previous time step is used as a + guessed circulation, :math:`\Gamma_\text{prev}`. + +#. The velocity at each control points :math:`j` is computed as the sum + of the wind velocity, the structural velocity, and the velocity + induced by all the vorticity in the domain, evaluated at the control + point location. + + .. math:: + \begin{aligned} + \vec{v}_j = \vec{V}_0 - \vec{V}_\text{elast} + \vec{v}_{\omega,\text{free}} + \vec{v}_{\Gamma_{ll}} + \end{aligned} + + :math:`\vec{v}_{\omega,\text{free}}` is the velocity induced by all free + vortex filaments, as introduced in Eq. :eq:`eq:eq510` . The contribution + of :math:`\vec{v}_{\Gamma_{ll}}` comes from the lifting-line panels and + the first row of near wake panels, for which the circulation is set to + :math:`\Gamma_\text{prev}` + +#. The circulation for all lifting-line panels :math:`j` is obtained as + follows. + + .. math:: + \begin{aligned} + \Gamma_{ll,j} =\frac{1}{2} C_{l,j}(\alpha_j) \frac{\left[ (\vec{v}_j \cdot \vec{N})^2 + (\vec{v}_j \cdot \vec{T})^2\right]^2\,dA}{ + \sqrt{\left[(\vec{v}_j\times \vec{dl})\cdot\vec{N}\right]^2 + \left[(\vec{v}_j\times \vec{dl})\cdot\vec{T}\right]^2} + } %\label{eq:} + ,\quad\text{with} + \quad + \alpha_j = \operatorname{atan}\left(\frac{\vec{v}_j\cdot\vec{N}}{\vec{v}_j \cdot \vec{T}} \right) + \end{aligned} + + The function :math:`C_{l,j}` is the lift coefficient obtained from + the polar data of blade section :math:`j` and :math:`\alpha_j` is the + angle of attack at the control point. + +#. The new circulation is set using the relaxation factor + :math:`k_\text{relax}` (**CircSolvRelaxation**): + + .. math:: + \begin{aligned} + \Gamma_\text{new}= \Gamma_\text{prev} + k_\text{relax} \Delta \Gamma + ,\qquad + \Delta \Gamma = \Gamma_{ll} - \Gamma_\text{prev} %\label{eq:} + \end{aligned} + +#. Convergence is checked using the criterion :math:`k_\text{crit}` + (**CircSolvConvCrit**): + + .. math:: + \begin{aligned} + \frac{ \operatorname{max}(|\Delta \Gamma|}{\operatorname{mean}(|\Gamma_\text{new}|)} < k_\text{crit} + \end{aligned} + + If convergence is not reached, steps 2-5 are repeated using + :math:`\Gamma_\text{new}` as the guessed circulation + :math:`\Gamma_\text{prev}`. + +No-flow-through Method +^^^^^^^^^^^^^^^^^^^^^^ + +A Weissinger-L-based representation (:cite:`olaf-Weissinger47_1`) +of the lifting surface is also +available (:cite:`olaf-Bagai94_1,olaf-Gupta06_1,olaf-Ribera07_1`). In this +method, the circulation is solved by satisfying a no-flow through +condition at the 1/4-chord points. It is selected with **CircSolvMethod=[2]**. + +Prescribed Circulation +^^^^^^^^^^^^^^^^^^^^^^ + +The final available method prescribes a constant circulation. A user +specified spanwise distribution of circulation is prescribed onto the +blades. It is selected with **CircSolvMethod=[3]**. + + +.. _sec:vortconv: + +Free Vorticity Convection +------------------------- + +The governing equation of motion for a vortex filament is given by the +convection equation of a Lagrangian marker: + +.. math:: + \frac{d\vec{r}}{dt}=\vec{V}(\vec{r},t) + :label: VortFilCart + +where :math:`\vec{r}` is the position of a Lagrangian marker. The Lagrangian +markers are the end points of the vortex filaments. The Lagrangian convection of +the filaments stretches the filaments and thus automatically accounts for strain +in the vorticity equation. + +At present, a first-order forward Euler method is used to numerically solve the +left-hand side of Eq. :eq:`VortFilCart` for the vortex filament location +(**IntMethod=[5]**). This is an explicit method solved using +Eq. :eq:`eq:Euler`. + +.. math:: + \vec{r} = \vec{r} + \vec{V} \Delta t + :label: eq:Euler + + +.. _sec:vortconvPolar: + +Free Vorticity Convection in Polar Coordinates +---------------------------------------------- + +The governing equation of motion for a vortex filament is given by: + +.. math:: + \frac{d\vec{r}(\psi,\zeta)}{dt}=\vec{V}[\vec{r}(\psi,\zeta),t] + :label: VortFil + +Using the chain rule, Eq. :eq:`VortFil` is rewritten as: + +.. math:: + \frac{\partial\vec{r}(\psi,\zeta)}{\partial\psi}+\frac{\partial\vec{r}(\psi,\zeta)}{\partial\zeta}=\frac{\vec{V}[\vec{r}(\psi,\zeta),t]}{\Omega} + :label: VortFil_expanded + +where :math:`d\psi/dt=\Omega` and +:math:`d\psi=d\zeta` (:cite:`olaf-Leishman02_1`). Here, +:math:`\vec{r}(\psi,\zeta)` is the position vector of a Lagrangian +marker, and :math:`\vec{V}[\vec{r}(\psi,\zeta)]` is the velocity. + +.. + At present, first-order forward Euler method is used to numerically solve the + left-hand side of Eq. :eq:`VortFil_expanded` for the vortex-filament location + [**IntMethod=5**]. This is an explicit method solved using Eq. :eq:`Euler`. + + .. math:: + \vec{r}(\psi+\Delta\psi_i,\zeta+\Delta\zeta) = \vec{r}(\psi,\zeta) + \vec{V}(\psi,\zeta) \Delta t + :label: Euler + +Induced Velocity and Velocity Field +----------------------------------- + +The velocity term on the right-hand side of +Eq. :eq:`VortFilCart` is a nonlinear function of the +vortex position, representing a combination of the freestream and +induced velocities (:cite:`olaf-Hansen08_1`). The induced +velocities at point :math:`\vec{x}`, caused by each straight-line +filament, are computed using the Biot-Savart law, which considers the +locations of the Lagrangian markers and the intensity of the vortex +elements (:cite:`olaf-Leishman02_1`): + +.. math:: + d\vec{v}(\vec{x})=\frac{\Gamma}{4\pi}\frac{d\vec{l}\times\vec{r}}{r^3} + :label: BiotSavart + +Here, :math:`\Gamma` is the circulation strength of the filament, +:math:`\vec{dl}` is an elementary length along the filament, :math:`\vec{r}` is +the vector between a point on the filament and the control point +:math:`\vec{x}`, and :math:`r=|\vec{r}|` is the norm of the vector. The +integration of the Biot-Savart law along the filament length, delimited by the +points :math:`\vec{x}_1` and :math:`\vec{x}_2` leads to: + +.. math:: + \begin{aligned} + \vec{v}(\vec{x}) + = F_\nu \frac{\Gamma}{4\pi} \frac{(r_1+r_2)}{r_1r_2(r_1r_2+\vec{r}_1\cdot\vec{r}_2) }\vec{r}_1\times\vec{r}_2 + \end{aligned} + :label: eq:BiotSavartSegment + +with :math:`\vec{r}_1= \vec{x}-\vec{x}_1` and :math:`\vec{r}_2= +\vec{x}-\vec{x}_2`. The factor :math:`F_\nu` is a regularization parameter, +discussed in :numref:`sec:RegularizationFunction`. :math:`r_0` is the filament +length, where :math:`\vec{r}_0= \vec{x}_2-\vec{x}_1`. The distance orthogonal to +the filament is: + +.. math:: + \begin{aligned} + \rho = \frac{|\vec{r}_1\times\vec{r}_2|}{r_0} + \end{aligned} + +The velocity at any point of the domain is obtained by superposition of +the velocity induced by all vortex filaments, and by superposition of +the primary flow, :math:`\vec{V}_0`, (here assumed divergence free): + +.. math:: + \begin{aligned} + \vec{V}(\vec{x}) = \vec{V}_0(\vec{x}) + \vec{v}_\omega(\vec{x}), \quad\text{with}\quad \vec{v}_\omega(\vec{x}) = \sum_{k} \vec{v}_k(\vec{x}) + \end{aligned} + :label: eq:eq510 + +where the sum is over all the vortex filaments, each of intensity +:math:`\Gamma_k`. The intensity of each filament is determined by spanwise and +time changes of the bound circulation, as discussed in :numref:`sec:circ`. In +tree-based methods, the sum over all vortex elements is reduced by lumping +together the elements that are far away from the control points. + + +.. _sec:Regularization: + +Regularization +-------------- + +Regularization and viscous diffusion +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The singularity that occurs in Eq. :eq:`BiotSavart` greatly affects the +numerical accuracy of vortex methods. By regularizing the “1-over-r” kernel of +the Biot-Savart law, it is possible to obtain a numerical method that converges +to the Navier-Stokes equations. The regularization is used to improve the +regularity of the discrete vorticity field, as compared to the “true” continuous +vorticity field. This regularization is usually obtained by convolution with a +smooth function. In this case, the regularization of the vorticity field and the +velocity field are the same. Some engineering models also perform regularization +by directly introducing additional terms in the denominator of the Biot-Savart +velocity kernel. The factor, :math:`F_\nu`, was introduced in +Eq. :eq:`eq:BiotSavartSegment` to account for this regularization. + +In the convergence proofs of vortex methods, regularization and viscous +diffusion are two distinct aspects. It is common practice in vortex filament +methods to blur the notion of regularization with the notion of viscous +diffusion. Indeed, for a physical vortex filament, viscous effects prevent the +singularity from occurring and diffuse the vortex strength with time. The +circular zone where the velocity drops to zero around the vortex is referred to +as the vortex core. A length increase of the vortex segment will result in a +vortex core radius decrease, and vice versa. Diffusion, on the other hand, +continually spreads the vortex radially. + +Because of the previously mentioned analogy, practitioners of vortex filament +methods often refer to regularization as "viscous-core" models and +regularization parameters as "core-radii." Additionally, viscous diffusion is +often introduced by modifying the regularization parameter in space and time +instead of solving the diffusion from the vorticity equation. The distinction is +made explicit in this document when clarification is required, but a loose +terminology is used when the context is clear. + +Determination of the regularization parameter +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The regularization parameter is both a function of the physics being modeled +(blade boundary layer and wake) and the choice of discretization. Contributing +factors are the chord length, the boundary layer height, and the volume that +each vortex filament is approximating. Currently the choice is left to the user +(**RegDetMethod=[0]**). Empirical results for a rotating blade are found in the +work of Gupta (:cite:`olaf-Gupta06_1`). As a guideline, the regularization parameter +may be chosen as twice the average spanwise discretization of the blade. This +guideline is implemented when the user chooses **RegDetMethod=[1]**. Further +refinement of this option will be considered in the future. + +.. _sec:RegularizationFunction: + +Implemented regularization functions +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Several regularization functions have been +developed (:cite:`olaf-Rankine58_1,olaf-Scully75_1,olaf-Vatistas91_1`). At present, five +options are available: 1) No correction, 2) the Rankine method, 3) the +Lamb-Oseen method, 4) the Vatistas method, or 5) the denominator offset method. +If no correction method is used, (**RegFunction=[0]**), :math:`F_\nu=1`. The +remaining methods are detailed in the following sections. Here, :math:`r_c` is +the regularization parameter (**WakeRegParam**) and :math:`\rho` is the distance +to the filament. Both variables are expressed in meters. + +Rankine +^^^^^^^ + +The Rankine method (:cite:`olaf-Rankine58_1`) is the simplest +regularization model. With this method, the Rankine vortex has a finite +core with a solid body rotation near the vortex center and a potential +vortex away from the center. If this method is used +(**RegFunction=[1]**), the viscous core correction is given by +Eq. :eq:`rankine`. + +.. math:: + F_\nu= \begin{cases} \rho^2/r_c^2 & 0 < \rho < 1 \\ + 1 & \rho > 1 \end{cases} + :label: rankine + +Here, :math:`r_c` is the viscous core radius of a vortex filament, +detailed in :numref:`sec:corerad`. + +Lamb-Oseen +^^^^^^^^^^ + +If the Lamb-Oseen method is used [**RegFunction=[2]**], the viscous core +correction is given by Eq. :eq:`lamboseen`. + +.. math:: + F_\nu= \bigg[1-\text{exp}(-\frac{\rho^2}{r_c^2})\bigg] + :label: lamboseen + +Vatistas +^^^^^^^^ + +If the Vatistas method is used [**RegFunction=[3]**], the viscous core +correction is given by Eq. :eq:`vatistas`. + +.. math:: + F_\nu + = \frac{\rho^2}{(\rho^{2n}+r_c^{2n})^{1/n}} + = \frac{(\rho/r_c)^2}{(1 + (\rho/r_c)^{2n})^{1/n}} + :label: vatistas + +Here, :math:`\rho` is the distance from a vortex segment to an arbitrary +point (:cite:`olaf-Abedi16_1`). Research from rotorcraft applications suggests a +value of :math:`n=2`, which is used in this work (:cite:`olaf-Bagai93_1`). + +Denominator Offset/Cut-Off +^^^^^^^^^^^^^^^^^^^^^^^^^^ + +If the denominator offfset method is used [**RegFunction=[4]**], the viscous +core correction is given by Eq. :eq:`denom` + +.. math:: + \begin{aligned} + \vec{v}(\vec{x}) + = \frac{\Gamma}{4\pi} \frac{(r_1+r_2)}{r_1r_2(r_1r_2+\vec{r}_1\cdot\vec{r}_2) + r_c^2 r_0^2} \vec{r}_1\times\vec{r}_2 + \end{aligned} + :label: denom + +Here, the singularity is removed by introducing an additive factor in the +denominator of Eq. :eq:`eq:BiotSavartSegment`, proportional to the filament +length :math:`r_0`. In this case, :math:`F_\nu=1`. This method is found in the +work of van Garrel (:cite:`olaf-Garrel03_1`). + +.. _sec:corerad: + +Time Evolution of the Regularization Parameter–Core Spreading Method +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are four available methods by which the regularization parameter may +evolve with time: 1) constant value, 2) stretching, 3) wake age, or 4) +stretching and wake age. The three latter methods blend the notions of viscous +diffusion and regularization. The notation :math:`r_{c0}` used in this section +corresponds to input file parameter value **WakeRegParam**. + +Constant +^^^^^^^^ + +If a constant value is selected, (**WakeRegMethod=[1]**), the value of +:math:`r_c` remains unchanged for all Lagrangian markers throughout the +simulation and is taken as the value given with the parameter **WakeRegParam** +in meters. + +.. math:: + r_c(\zeta) = r_{c0} + :label: cst + +Here, :math:`\zeta` is the vortex wake age, measured from its emission time. + +Stretching +^^^^^^^^^^ + +If the stretching method is selected, (**WakeRegMethod=[2]**), the viscous core +radius is modeled by Eq. :eq:`stretch`. + +.. math:: + r_c(\zeta,\epsilon) = r_{c0} (1+\epsilon)^{-1} + :label: stretch + +.. math:: + \epsilon = \frac{\Delta l}{l} + +Here, :math:`\epsilon` is the vortex-filament strain, :math:`l` is the filament +length, and :math:`\Delta l` is the change of length between two time steps. The +integral in Eq. :eq:`stretch` represents strain effects. + +Wake Age / Core-Spreading +^^^^^^^^^^^^^^^^^^^^^^^^^ + +If the wake age method is selected, (**WakeRegMethod=[3]**), the viscous core +radius is modeled by Eq. :eq:`age`. + +.. math:: + r_c(\zeta) = \sqrt{r_{c0}^2+4\alpha\delta\nu \zeta} + :label: age + +where :math:`\alpha=1.25643`, :math:`\nu` is kinematic viscosity, and +:math:`\delta` is a viscous diffusion parameter (typically between :math:`1` and +:math:`1,000`). The parameter :math:`\delta` is provided in the input file as +**CoreSpreadEddyVisc**. Here, the term :math:`4\alpha\delta\nu \zeta`, accounts +for viscous effects as the wake propagates downstream. The higher the background +turbulence, the more diffusion of the vorticity with time, and the higher the +value of :math:`\delta` should be. This method partially accounts for viscous +diffusion of the vorticity while neglecting the interaction between the wake +vorticity itself or between the wake vorticity and the background flow. It is +often referred to as the core-spreading method. Setting **DiffusionMethod=[1]** +is the same as using the wake age method (**WakeRegMethod=[3]**). + +Stretching and Wake Age +^^^^^^^^^^^^^^^^^^^^^^^ + +If the stretching and wake-age method is selected (**WakeRegMethod=[4]**), +the viscous core radius is modeled by +Eq. :eq:`stretchandage`. + +.. math:: + r_c(\zeta,\epsilon) = \sqrt{r_{c0}^2 + 4\alpha\delta\nu \zeta \big(1+\epsilon\big)^{-1} } + :label: stretchandage + +.. _sec:diffusion: + +Diffusion +--------- + +The viscous-splitting assumption is used to solve for the convection and +diffusion of the vorticity separately. The diffusion term :math:`\nu \Delta +\vec{\omega}` represents molecular diffusion. This term allows for viscous +connection of vorticity lines. Also, turbulent flows will diffuse the vorticity +in a similar manner based on a turbulent eddy viscosity. + +The parameter **DiffusionMethod** is used to switch between viscous diffusion +methods. Currently, only the core-spreading method is implemented. The method +is described in :numref:`sec:corerad` since it is equivalent to the increase of +the regularization parameter with the wake age. + diff --git a/docs/source/user/aerodyn-olaf/OutputFiles.rst b/docs/source/user/aerodyn-olaf/OutputFiles.rst new file mode 100644 index 0000000000..8068e64b21 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/OutputFiles.rst @@ -0,0 +1,24 @@ +.. _Output-Files: + +Output Files +============ + +The OLAF module itself does not produce its own output file. However, additional +output channels are made available in *AeroDyn15*. As such, the *AeroDyn15* +output file is briefly described as well as the outputs made available with +OLAF. Visualization files are generated by using the parameter, **WrVTK**. This +parameter is available in the OLAF input file, in which case the VTK files are +written to the folder ``vtk_fvw``, or the primary ``.fst`` file, in which case +the VTK files are written to the folder ``vtk``. + + +Results File +------------ + +OpenFAST generates a master results file that includes the *AeroDyn15* +results. The results are in table format, where each column is a data +channel, and each row corresponds to a simulation-output time step. The +data channels are specified in the *OUTPUTS* section in the *AeroDyn15* +primary input file. The column format of the AeroDyn-generated files is +specified using the **OutFmt** parameter of the OpenFAST driver input +file. diff --git a/docs/source/user/aerodyn-olaf/RunningOLAF.rst b/docs/source/user/aerodyn-olaf/RunningOLAF.rst new file mode 100644 index 0000000000..4b91c6150c --- /dev/null +++ b/docs/source/user/aerodyn-olaf/RunningOLAF.rst @@ -0,0 +1,12 @@ +.. _Running-OLAF: + +Running OLAF +============ + +As OLAF is a module of OpenFAST, the process of downloading, compiling, +and running OLAF is the same as that for OpenFAST. Such instructions are +available in the :ref:`installation` documentation. + +.. note:: + To improve the speed of FVW module, the user may wish to compile with + `OpenMP`. To do so, add the `-DOPENMP=ON` option with CMake. diff --git a/docs/source/user/aerodyn-olaf/Schematics/FVWwithOpenFAST.pdf b/docs/source/user/aerodyn-olaf/Schematics/FVWwithOpenFAST.pdf new file mode 100644 index 0000000000..554dfa9386 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/FVWwithOpenFAST.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/FVWwithOpenFAST.png b/docs/source/user/aerodyn-olaf/Schematics/FVWwithOpenFAST.png new file mode 100644 index 0000000000..e474d79c1e Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/FVWwithOpenFAST.png differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/FilamentRegularization.pdf b/docs/source/user/aerodyn-olaf/Schematics/FilamentRegularization.pdf new file mode 100644 index 0000000000..09d2d50321 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/FilamentRegularization.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/FilamentRegularization.png b/docs/source/user/aerodyn-olaf/Schematics/FilamentRegularization.png new file mode 100644 index 0000000000..77a97adfce Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/FilamentRegularization.png differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/LagrangianMarkers.pdf b/docs/source/user/aerodyn-olaf/Schematics/LagrangianMarkers.pdf new file mode 100644 index 0000000000..4d911dadaf Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/LagrangianMarkers.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/LagrangianMarkers.png b/docs/source/user/aerodyn-olaf/Schematics/LagrangianMarkers.png new file mode 100644 index 0000000000..ea4628c990 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/LagrangianMarkers.png differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/OpenFAST.pdf b/docs/source/user/aerodyn-olaf/Schematics/OpenFAST.pdf new file mode 100644 index 0000000000..7a922ec760 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/OpenFAST.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/OpenFAST.png b/docs/source/user/aerodyn-olaf/Schematics/OpenFAST.png new file mode 100644 index 0000000000..c3d9084e3f Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/OpenFAST.png differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/Stencil.pdf b/docs/source/user/aerodyn-olaf/Schematics/Stencil.pdf new file mode 100644 index 0000000000..064309fe64 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/Stencil.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/Stencil.png b/docs/source/user/aerodyn-olaf/Schematics/Stencil.png new file mode 100644 index 0000000000..7097d3b0b2 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/Stencil.png differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.pdf b/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.pdf new file mode 100644 index 0000000000..b0c1fb9c10 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.png b/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.png new file mode 100644 index 0000000000..a4973027c1 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.png differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.tex b/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.tex new file mode 100644 index 0000000000..4f2289dd56 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/Schematics/VortexCodeWorkFlow.tex @@ -0,0 +1,80 @@ +%% Creator: Inkscape inkscape 0.92.3, www.inkscape.org +%% PDF/EPS/PS + LaTeX output extension by Johan Engelen, 2010 +%% Accompanies image file 'VortexCodeWorkFlow.pdf' (pdf, eps, ps) +%% +%% To include the image in your LaTeX document, write +%% \input{.pdf_tex} +%% instead of +%% \includegraphics{.pdf} +%% To scale the image, write +%% \def\svgwidth{} +%% \input{.pdf_tex} +%% instead of +%% \includegraphics[width=]{.pdf} +%% +%% Images with a different path to the parent latex file can +%% be accessed with the `import' package (which may need to be +%% installed) using +%% \usepackage{import} +%% in the preamble, and then including the image with +%% \import{}{.pdf_tex} +%% Alternatively, one can specify +%% \graphicspath{{/}} +%% +%% For more information, please see info/svg-inkscape on CTAN: +%% http://tug.ctan.org/tex-archive/info/svg-inkscape +%% +\begingroup% + \makeatletter% + \providecommand\color[2][]{% + \errmessage{(Inkscape) Color is used for the text in Inkscape, but the package 'color.sty' is not loaded}% + \renewcommand\color[2][]{}% + }% + \providecommand\transparent[1]{% + \errmessage{(Inkscape) Transparency is used (non-zero) for the text in Inkscape, but the package 'transparent.sty' is not loaded}% + \renewcommand\transparent[1]{}% + }% + \providecommand\rotatebox[2]{#2}% + \newcommand*\fsize{\dimexpr\f@size pt\relax}% + \newcommand*\lineheight[1]{\fontsize{\fsize}{#1\fsize}\selectfont}% + \ifx\svgwidth\undefined% + \setlength{\unitlength}{1584.33259703bp}% + \ifx\svgscale\undefined% + \relax% + \else% + \setlength{\unitlength}{\unitlength * \real{\svgscale}}% + \fi% + \else% + \setlength{\unitlength}{\svgwidth}% + \fi% + \global\let\svgwidth\undefined% + \global\let\svgscale\undefined% + \makeatother% + \begin{picture}(1,0.37987951)% + \lineheight{1}% + \setlength\tabcolsep{0pt}% + \put(0,0){\includegraphics[width=\unitlength,page=1]{VortexCodeWorkFlow.pdf}}% + \put(0.65944109,0.11446444){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.25535428\unitlength}\centering $\vec{v}_{i,ll}, (\vec{r}_{r})$\end{minipage}}}% + \put(0,0){\includegraphics[width=\unitlength,page=2]{VortexCodeWorkFlow.pdf}}% + \put(0.63558708,0.20735708){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.20717198\unitlength}\centering \textbf{Vortex code}\end{minipage}}}% + \put(0.60215168,0.18502836){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.27356877\unitlength}\centering $\vec{r}, \vec{\Gamma}_v$\end{minipage}}}% + \put(0.32921211,0.30084711){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.30485953\unitlength}\raggedright 1. Tower shadow model\\ \ \ \ \ (update of $\vec{V}_{\infty}$)\end{minipage}}}% + \put(0.32826903,0.23341478){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.3956149\unitlength}\raggedright 2. Induction computation\end{minipage}}}% + \put(0.32826903,0.13392726){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.5344643\unitlength}\raggedright 3. Quasi steady forces on the lifting lines\end{minipage}}}% + \put(0.32826903,0.08442459){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.51629305\unitlength}\raggedright 4. Dynamic stall model\end{minipage}}}% + \put(0.49325791,0.33819968){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.20355574\unitlength}\centering \textbf{AeroDyn15}\end{minipage}}}% + \put(0.79169925,0.10320964){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.25535428\unitlength}\centering $\vec{f}_{ll}$\end{minipage}}}% + \put(0,0){\includegraphics[width=\unitlength,page=3]{VortexCodeWorkFlow.pdf}}% + \put(0.79577993,0.29769798){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.25535428\unitlength}\centering $\vec{r}_{ll}, \vec{r}_{r}$\end{minipage}}}% + \put(0,0){\includegraphics[width=\unitlength,page=4]{VortexCodeWorkFlow.pdf}}% + \put(-0.00885268,0.27822337){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.20355574\unitlength}\centering \textbf{InflowWind}\end{minipage}}}% + \put(0,0){\includegraphics[width=\unitlength,page=5]{VortexCodeWorkFlow.pdf}}% + \put(0.69583824,0.27908716){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.08495527\unitlength}\centering \textbf{BEM}\end{minipage}}}% + \put(0,0){\includegraphics[width=\unitlength,page=6]{VortexCodeWorkFlow.pdf}}% + \put(0.01537801,0.32400133){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.44217675\unitlength}\centering $\vec{V}_\infty=$\\ $[\vec{V}_{\infty,ll}, \vec{V}_{\infty,r}] $\end{minipage}}}% + \put(0.02471082,0.17907865){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.41731078\unitlength}\centering $\vec{x}_{\text{elast},ll} =$\\ $ [\vec{r}_{ll}, \vec{\Lambda}_{ll}, \vec{\dot{r}}_{ll}, \vec{\omega}_{ll}]$\\ \end{minipage}}}% + \put(0,0){\includegraphics[width=\unitlength,page=7]{VortexCodeWorkFlow.pdf}}% + \put(-0.01097736,0.13673){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.20355574\unitlength}\centering \textbf{ElastoDyn}\end{minipage}}}% + \put(0.57551823,0.27600282){\color[rgb]{0,0,0}\makebox(0,0)[lt]{\begin{minipage}{0.41731078\unitlength}\raggedright $\vec{r}_{\text{elast},ll}$\\ $\vec{V}_\infty$\end{minipage}}}% + \end{picture}% +\endgroup% diff --git a/docs/source/user/aerodyn-olaf/Schematics/VortexLatticeMethod.pdf b/docs/source/user/aerodyn-olaf/Schematics/VortexLatticeMethod.pdf new file mode 100644 index 0000000000..d4486621d8 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/VortexLatticeMethod.pdf differ diff --git a/docs/source/user/aerodyn-olaf/Schematics/VortexLatticeMethod.png b/docs/source/user/aerodyn-olaf/Schematics/VortexLatticeMethod.png new file mode 100644 index 0000000000..2db30e3972 Binary files /dev/null and b/docs/source/user/aerodyn-olaf/Schematics/VortexLatticeMethod.png differ diff --git a/docs/source/user/aerodyn-olaf/StateSpace.rst b/docs/source/user/aerodyn-olaf/StateSpace.rst new file mode 100644 index 0000000000..501e939573 --- /dev/null +++ b/docs/source/user/aerodyn-olaf/StateSpace.rst @@ -0,0 +1,185 @@ +.. role:: raw-latex(raw) + :format: latex +.. + +State-Space Representation and Integration with OpenFAST +======================================================== + +State, Constraint, Input, and Output Variables +---------------------------------------------- + +The OLAF module has been integrated into the latest version of OpenFAST via +*AeroDyn15*, following the OpenFAST modularization +framework (:cite:`olaf-Jonkman13_1,olaf-Sprague15_1`). To follow the OpenFAST framework, +the vortex code is written as a module, and its formulation comprises state, +constraint, and output equations. The data manipulated by the module include the +following vectors: constant parameters, :math:`\vec{p}`; inputs, +:math:`\vec{u}`; constrained state, :math:`\vec{z}`; states, :math:`\vec{x}`; +and outputs, :math:`\vec{y}`. The vectors are defined as follows: + +- Parameters, :math:`\vec{p}~-` a set of internal system values that are + independent of the states and inputs. The parameters can be fully defined at + initialization and characterize the system state and output equations. + +- Inputs, :math:`\vec{u}~-` a set of values supplied to the module that, along + with the states, are needed to calculate future states and the system output. + +- Constraint states, :math:`\vec{z}~-` algebraic variables that are calculated + using a nonlinear solver, based on values from the current time step. + +- States, :math:`\vec{x}~-` a set of internal values of the module. They are + influenced by the inputs and used to calculate future state values and + output. Continuous states are employed, meaning that the states are + differentiable in time and characterized by continuous time-differential + equations. + +- Outputs, :math:`\vec{y}~-` a set of values calculated and returned by the + module that depend on the states, inputs, and/or parameters through output + equations. + +The parameters of the vortex code include: + +- Fluid characteristics: kinematic viscosity, :math:`\nu`. + +- Airfoil characteristics: chord :math:`c` and polar data -- + :math:`C_l(\alpha)`, :math:`C_d(\alpha)`, :math:`C_m(\alpha)`). + +- Algorithmic methods and parameters, e.g., regularization, viscous + diffusion, discretization, wake geometry, and acceleration. + +The inputs of the vortex code are: + +- Position, orientation, translational velocity, and rotational + velocity of the different nodes of the lifting lines + (:math:`\vec{r}_{ll}`, :math:`\Lambda_{ll}`, + :math:`\vec{\dot{r}}_{ll}`, and :math:`\vec{\omega}_{ll}`, + respectively), gathered into the vector, + :math:`\vec{x}_{\text{elast},ll}`, for conciseness. These quantities + are handled using the mesh-mapping functionality and data structure + of OpenFAST. + +- Disturbed velocity field at requested locations, written + :math:`\vec{V}_0=[\vec{V}_{0,ll}, \vec{V}_{0,m}]`. Locations are requested + for lifting-line points, :math:`\vec{r}_{ll}`, and Lagrangian markers, + :math:`\vec{r}_m`. Based on the parameters, this disturbed velocity field may + contain the following influences: freestream, shear, veer, turbulence, tower, + and nacelle disturbance. The locations where the velocity field is requested + are typically the location of the Lagrangian markers. + +The constraint states are: + +- The circulation intensity along the lifting lines, + :math:`\Gamma_{ll}`. + +The continuous states are: + +- The position of the Lagrangian markers, :math:`\vec{r}_m` + +- The vorticity associated with each vortex element, :math:`\vec{\omega}_e`. + For a projection of the vorticity onto vortex segments, this corresponds to + the circulation, :math:`\vec{\Gamma}_e`. For each segment, + :math:`\vec{\Gamma}_e= \Gamma_e \vec{dl}_e =\vec{\omega}_e dV_e`, with + :math:`\vec{dl}_e` and :math:`dV_e`, the vortex segment length and its + equivalent vortex volume. + +The outputs are [1]_: + +- The induced velocity at the lifting-line nodes, + :math:`\vec{v}_{i,ll}` + +- The locations where the undisturbed wind is computed, :math:`\vec{r}_{r}` + (typically :math:`\vec{r_{r}}=\vec{r}_m`). + +State, Constraint, and Output Equations +--------------------------------------- + +An overview of the states, constraints, and output equations is given here. More +details are provided in :numref:`OLAF-Theory`. The constraint equation is used +to determine the circulation distribution along the span of each lifting line. +For the van Garrel method, this circulation is a function of the angle of attack +along the blade and the airfoil coefficients. The angle of attack at a given +lifting-line node is a function of the undisturbed velocity, +:math:`\vec{v}_{0,ll}`, and the velocity induced by the vorticity, +:math:`\vec{v}_{i,ll}`, at that point. Part of the induced velocity is caused by +the vorticity being shed and trailed at the current time step, which in turn is +a function of the circulation distribution along the lifting line. This +constraint equation may be written as: + +.. math:: + \vec{Z} = \vec{0} = \vec{\Gamma}_{ll} - \vec{\Gamma}_p\bigg(\vec{\alpha}(\vec{x},\vec{u}),\vec{p}\bigg) + +where :math:`\vec{\Gamma}_p` is the function that returns the circulation along +the blade span, according to one of the methods presented in :numref:`sec:circ`. + +The state equation specifies the time evolution of the vorticity and the +convection of the Lagrangian markers: + +.. math:: + \begin{aligned} + \frac{d \vec{\omega}_e}{dt} &= \bigg[(\vec{\omega}\cdot\nabla)\vec{v} + \nu\nabla^2 \vec{\omega} \bigg]_e + \end{aligned} + +.. math:: + \begin{aligned} + \frac{d \vec{r}_m}{dt} &= \vec{V}(\vec{r}_m) + =\vec{V}_0(\vec{r}_m) + \vec{v}_\omega(\vec{r}_m) + =\vec{V}_0(\vec{r}_m) + \vec{V}_\omega(\vec{r}_m, \vec{r}_m, \vec{\omega}) + \end{aligned} + :label: eq:Convection + +Here, + +- :math:`\vec{v}_\omega` is the velocity induced by the vorticity in the + domain; +- :math:`\vec{V}_\omega(\vec{r},\vec{r}_m,\vec{\omega})` is the function that + computes this induced velocity at a given point, :math:`\vec{r}`, based on + the location of the Lagrangian markers and the intensity of the vortex elements; +- the subscript :math:`e` indicates that a quantity is applied to an element; + and +- the vorticity, :math:`\vec{\omega}`, is recovered from the vorticity of the + vortex elements by means of discrete convolutions. + +For vortex-segment simulations, the viscous-splitting algorithm is used, and the +convection step (Eq. :eq:`eq:Convection`) is the main state equation being +solved for. The vorticity stretching is automatically accounted for, and the +diffusion is performed *a posteriori*. The velocity function, +:math:`\vec{V}_\omega`, uses the Biot-Savart law. The output equation is: + +.. math:: + \begin{aligned} + \vec{y}_1&=\vec{v}_{i,ll} = \vec{V}_\omega ( \vec{r}_{ll}, \vec{r}_m, \vec{\omega}) \\ + \vec{y}_2&=\vec{r}_{r} + \end{aligned} + +Integration with AeroDyn15 +-------------------------- + +The vortex code has been integrated as a submodule of the aerodynamic module of +OpenFAST, *AeroDyn15*. The data workflow between the different modules and +submodules of OpenFAST is illustrated in :numref:`AD15-OLAF`. +AeroDyn inputs such as BEM options (e.g., tip-loss factor), skew model, and +dynamic inflow are discarded when the vortex code is used. The environmental +conditions, tower shadow, and dynamic stall model options are used. This +integration required a restructuring of the *AeroDyn15* module to isolate the +parts of the code related to tower shadow modeling, induction computation, +lifting-line-forces computations, and dynamic stall. The dynamic stall model is +adapted when used in conjunction with the vortex code to ensure the effect of +shed vorticity is not accounted for twice. The interface between *AeroDyn15* and +the inflow module, *InflowWind*, was accommodated to include the additionally +requested points by the vortex code. + + +.. _AD15-OLAF: + +.. figure:: Schematics/VortexCodeWorkFlow.png + :alt: OpenFAST-FVW code integration workflow + :width: 100% + :align: center + + OpenFAST-OLAF code integration workflow + + + +.. [1] + The loads on the lifting line are not an output of the vortex code; + their calculation is handled by a separate submodule of *AeroDyn*. diff --git a/docs/source/user/aerodyn-olaf/bibliography.bib b/docs/source/user/aerodyn-olaf/bibliography.bib new file mode 100644 index 0000000000..90f791db4b --- /dev/null +++ b/docs/source/user/aerodyn-olaf/bibliography.bib @@ -0,0 +1,438 @@ +@article{Larsen08_1, + title= {Wake Meander: A Pragmatic Approach}, + author= {G. C. Larsen and H. A. Madsen and K. Thomsen and et al.}, + journal= {Wind Energy}, + volume= {11}, + pages= {337-95}, + year= {2008}, + publisher={John Wiley \& Sons, Ltd.}, + doi = {http://onlinelibrary.wiley.com/doi/10.1002/we.267/epdf} +} + +@inproceedings{Bagai94_1, + author= {A. Bagai and J. G. Leishman}, + title= {Rotor Free-Wake Modeling using a Pseudo-Implicit Technique Including Comparisons with Experimental Data}, + booktitle= {50th Annual Forum of the American Helicopter Society}, + year= {1994}, + address= {Washington, D.C.} +} + +@article{Quon18_1, + title= {Comparison of Wake Characterization Methods for Large-Eddy Simulations of a Rotor in Stratified Flow}, + author= {E. Quon and M. Churchfield and J. Jonkman}, + journal= {Computers & Fluids}, + year= {2018} +} + +@article{Martinez17_1, + title= {Optimal Smoothing Length Scale for Actuator Line Models of Wind Turbine Blades Based on Gaussian Body Force Distribution}, + author= {L. A. Martinez-Tossas and M. J. Churchfield and C. Meneveau}, + journal= {Wind Energy}, + volume= {20}, + pages= {1083-1096}, + year= {2017}, + publisher={John Wiley \& Sons, Ltd.}, + doi = {http://onlinelibrary.wiley.com/doi/10.1002/we.2081/epdf} +} + +@article{Vatistas91_1, + Author = {G. H. Vatistas and V. Koezel and W. C. Mih}, + Title = {A Simpler Model for Concentrated Vortices}, + Journal = {Experiments in Fluids}, + Volume = {11}, + Number = {1}, + Pages = {73-76}, + Year = {1991}} + +@article{Quon19_1, + title= {Comparison of Wake Characterization Methods for Large-Eddy Simulations of a Rotor in Stratified Flow}, + author= {E. Quon and M. Churchfield and J. Jonkman}, + journal= {Computers \& Fluids}, + year= {2019 (Forthcoming)} +} + +@inproceedings{Jonkman18_1, + title= {Validation of FAST.Farm Against Large-Eddy Simulations}, + author= {J. Jonkman and P. Doubrawa and N. Hamilton and et al.}, + series= {TORQUE 2018}, + date = {20-22}, + month = {June}, + year= {2018}, + publisher={EAWE}, + address= {Milano, Italy} +} + +@Book{Hansen08_1, + author = {M. O. L. Hansen}, + title = {Aerodynamics of Wind Turbines}, + publisher = {Earthscan}, + year = {2008}, + address = {London; Sterling, VA} +} + +@techreport{Weissinger47_1, + Author = {J. Weissinger}, + Title = {The Lift Distribution of Swept-Back Wings}, + Institution = {NACA}, + Type = {Technical report}, + Number = {TM 1120}, + Year = {1947} +} + +@techreport{Jonkman13_1, + Author = {J. Jonkman}, + Title = {The New Modularization Framework for the FAST Wind Turbine CAE Tool}, + Institution = {National Renewable Energy Laboratory}, + Type = {Technical report}, + Number = {NREL/CP-5000-57228}, + Year = {2013} +} + +@techreport{Jonkman15_1, + Author = {J. Jonkman and M. A. Sprague and B. J. Jonkman}, + Title = {FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples}, + Institution = {National Renewable Energy Laboratory}, + Type = {Technical report}, + Number = {NREL/CP-2C00-63203}, + Year = {2015} +} + +@phdthesis{Gupta06_1, + Author = {S. Gupta}, + Title = {Development of a Time-Accurate Viscous Lagrangian Vortex Wake Model for Wind Turbine Applications}, + School = {Univeristy of Maryland}, + Address = {College Park, MD}, + Type = {PhD thesis}, + Year = {2006} +} + +@phdthesis{Scully75_1, + Author = {M. P. Scully}, + Title = {Computation of Helicopter Rotor Wake Geometry and Its Influence on Rotor Harmonic Airloads}, + School = {Massachusetts Institute of Technology}, + Address = {Cambridga, MA}, + Type = {PhD thesis}, + Year = {1975} +} + + +@phdthesis{Ribera07_1, + Author = {M. Ribera}, + Title = {Helicopter Flight Dynamics Simulation with a Time-Accurate Free-Vortex Wake Model}, + School = {University of Maryland}, + Address = {College Park, MD}, + Type = {PhD thesis}, + Year = {2007}} + +@inproceedings{Doubrawa18_1, + author= {P. Doubrawa and J. Annoni and J. Jonkman and et al.}, + title= {Optimization-Based Calibration of FAST.Farm Parameters Against SOWFA}, + booktitle={AIAA SciTech Forum}, + series= {36th Wind Energy Symposium}, + date = {8-13}, + month = {January}, + year= {2018}, + publisher={AIAA}, + address= {Kissimmee, FL}, + doi = {https://arc.aiaa.org/doi/pdf/10.2514/6.2018-0512} +} + +@inproceedings{Shaler19_1, + title= {FAST.Farm Response of Varying Wind Inflow Techniques}, + author= {K. Shaler and J. Jonkman and P. Doubrawa and N. Hamilton}, + booktitle={AIAA SciTech Forum}, + series= {37th Wind Energy Symposium}, + date = {7-11}, + month = {January}, + year= {2019}, + publisher={AIAA}, + address= {San Diego, CA}, + doi = {https://arc.aiaa.org/doi/pdf/10.2514/6.2019-2086} +} + +@inproceedings{Jonkman17_1, + title= {Development of FAST.Farm: A New MultiPhysics Engineering Tool for Wind-Farm Design and Analysis}, + author= {J. Jonkman and J. Annoni and G. Hayman and B. Jonkman and A. purkayastha}, + booktitle={AIAA SciTech Forum}, + series= {35th Wind Energy Symposium}, + date = {9-13}, + month = {January}, + year= {2017}, + publisher={AIAA}, + address= {Grapevine, TX}, + doi = {http://arc.aiaa.org/doi/pdf/10.2514/6.2017-0454} +} + +@inproceedings{Churchfield15_1, + title= {A Comparison of the Dynamic Wake Meandering Model, Large-Eddy Simulations, and Field Data at the Egmond aan Zee Offshore Wind Plant}, + author= {M. J. Churchfield and P. J. Moriarty and Y. Hao and et al.}, + booktitle={AIAA SciTech Forum}, + series= {33rd Wind Energy Symposium}, + date = {5-9}, + month = {January}, + year= {2015}, + publisher={AIAA}, + address= {Kissimmee, FL}, + doi = {http://dx.doi.org/10.2514/6.2015-0724} +} + +@inproceedings{Churchfield12_1, + title= {A Large-Eddy Simulation of Wind-Plant Aerodynamics}, + author= {M. J. Churchfield and P. J. Moriarty and L. A. Martinez and et al.}, + series= {50th AIAA Aerospace Sciences Meeting}, + date = {9-12}, + month = {January}, + year= {2012}, + publisher={AIAA}, + address= {Nashville, TN}, + doi = {http://dx.doi.org/10.2514/6.2012-537} +} + +@techreport{Jonkman09_1, + title= {Definition of a 5-MW Reference Wind Turbine for Offshore System Development}, + author= {Jonkman, J. and Butterfield, S. and Musial, W. and Scott, G.}, + number= {NREL/TP-500-38060}, + institution={National Renewable Energy Laboratory}, + address= {Golden, CO}, + month= {February}, + year= {2009} +} + +@techreport{TurbSim_1, + title= {TurbSim User's Guide v2.00.00}, + author= {Jonkman, B.}, + number= {NREL/TP-xxxx-xxxxx}, + institution={National Renewable Energy Laboratory}, + address= {Golden, CO}, + month= {October}, + year= {2014} +} + +@techreport{IEC_1, + title= {Wind Turbines - Part 1: Design Requirements}, + author= {IEC 61400-1}, + number= {3rd edition}, + institution={International Electrotechnical Commission}, + address= {Geneva, Switzerland}, + month= {March}, + year= {2006} +} + +@techreport{Simms01_1, + title= {NREL Unsteady Aerodynamics Experiment in the NASA-Ames Wind Tunnel: A Comparison of Predictions to Measurements}, + author= {Simms, D. and Schreck, S. and Hand, M. and Fingersh, L.J.}, + number= {NREL/TP-500-29494}, + institution={National Renewable Energy Laboratory}, + address= {Golden, CO}, + month= {June}, + year= {2001} +} + +@techreport{Jonkman18_2, + title= {FAST.Farm User's Guide and Theory Manual}, + author= {J. M. Jonkman}, + number= {NREL/TP-xxxx-xxxxx}, + institution={National Renewable Energy Laboratory}, + address= {Golden, CO}, + month= {Unpublished}, + year= {2018} +} + +@misc{FAST, +title = {OpenFAST Documentation}, +month = {November}, +year = {2017}, +url = {http://openfast.readthedocs.io/en/master/} +} + +@misc{SAMWICH, + author = {E. Quon}, + title = {SAMWICH Wake-Tracking Toolbox}, + publisher = {GitHub}, + journal = {GitHub repository}, + howpublished = {\url{https://github.com/ewquon/waketracking}}, + year= {2017} +} + +@phdthesis{Krista12_1, + Author = {K. Kecskemety}, + Title = {Assessing the Influence of Wake Dynamics on the Performance and Aeroelastic Behavior of Wind Turbines}, + School = {Ohio State University}, + Address = {Columbus, OH}, + Type = {PhD thesis}, + Year = {2012}} + +@book{Leishman_book, + Author = {J. Leishman}, + Title = {Principles of Helicopter Aerodynamics}, + Publisher = {Cambridge Univ. Press}, + Address = {Cambridge, MA}, + Year = {2006}} + +@book{Rankine58_1, + Author = {W. J. M. Rankine}, + Title = {Manual of Applied Mechanics}, + Publisher = {Griffen Co.}, + Address = {London}, + Year = {1858}} + +@article{Leishman02_1, + Author = {J. G. Leishman and M. J. Bhagwat and A. Bagai}, + Title = {Free-Vortex Filament Methods for the Analysis of Helicopter Rotor Wakes}, + Journal = {Journal of Aircraft}, + Volume = {39}, + Number = {5}, + Pages = {759-775}, + Year = {2002}} + +@inproceedings{Ananthan02_1, + Author = {S. Ananthan and J. G. Leishman and M. Ramasamy}, + Title = {The Role of Filament Stretching in the Free-Vortex Modeling of Rotor Wakes}, + booktitle = {58th Annual Forum and Technology Display of the American Helicopter Society International}, + year = {2002}, + address = {Montreal, Canada}} + +@article{Gupta05_1, + Author = {S. Gupta and J. G. Leishman}, + Title = {Free-Vortex Filament Methods for the Analysis of Helicopter Rotor Wakes}, + Journal = {Journal of Aircraft}, + Volume = {39}, + Number = {5}, + Pages = {759-775}, + Year = {2002}} + +@techreport{Wiser17_1, + title= {2016 Wind Technologies Market Report}, + author= {R. Wiser and M. Bolinger}, + number= {DOE/GO-102917-5033}, + institution={Lawrence Berkeley National Laboratory}, + address= {Berkeley, CA}, + month= {August}, + year= {2017}, + doi = {10.2172/1393638}} + +@phdthesis{Shaler19_2, + Author = {K. Shaler}, + Title = {Wake Interaction Modeling Using A Parallelized Free Vortex Wake Model}, + School = {Ohio State University}, + Address = {Columbus, OH}, + Type = {PhD thesis}, + Year = {2020}} + +@phdthesis{Abedi16_1, + Author = {H. Abedi}, + Title = {Development of Vortex Filament Method for Wind Power Aerodynamics}, + School = {Chalmers University of Technology}, + Address = {Gothenburg, Sweden}, + Type = {PhD thesis}, + Year = {2016}} + + +@techreport{Johnson19_1, + Author={N. Johnson and P. Bortolotti and K. Dykes and et al.}, + Title={Investigation of Innovative Rotor Concepts for the Big Adaptive Rotor Project}, + institution={National Renewable Energy Laboratory}, + number={NREL/TP-5000-73605}, + Year=2019 + } + +@techreport{Sprague15_1, + title={FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples}, + author={Michael A. Sprague and Jason M. Jonkman and Bonnie J. Jonkman}, + institution={National Renewable Energy Laboratory}, + number={NREL/CP-2C00-63203}, + year={2015} +} + +@article{Miras17_1, + author = {M. Sessarego and N. Ramos Garc{\'i}a and J. N. S{\o}rensen and W. Z. Shen}, + title = {Development of an aeroelastic code based on three-dimensional viscous-inviscid method for wind turbine computations}, + year = {2017}, + doi = {10.1002/we.2085}, + volume = {20}, + pages = {1145-1170}, + journal = {Wind Energy}, + number = {7}, +} + +@article{Bagai93_1, + author = {A. Bagai and J. G. Leishman}, + title = {Flow Visualization of Compressible Vortex Structures Using Density Gradient Techniques}, + year = {1993}, + volume = {15}, + pages = {431-442}, + journal = {Experiments in Fluids}, + number = {6} +} + +@phdthesis{Papadakis14_1, + author = {G. Papadakis}, + title = {Development of a hybrid compressible vortex particle method and application to external problems including helicopter flows}, + school = {National Technical University of Athens}, + year = {2014}, +} +@article{Voutsinas06_1, + author = {S. G. Voutsinas}, + title = {Vortex methods in aeronautics: how to make things work}, + journal = {International Journal of Computational Fluid Dynamics}, + year = {2006}, +} + +@article{Rosenhead31_1, + author = {L. Rosenhead}, + title = {The Formation of Vortices from a Surface of Discontinuity}, + journal = {Proceedings of the Royal Society of London. Series A, Containing Papers of a Mathematical and Physical Character}, + volume = {134}, + number = {823}, + pages = {170-192}, + url = {http://www.jstor.org/stable/95835}, + ISSN = {09501207}, + year = {1931}, + publisher = {The Royal Society}, +} + +@article{Winckelmans93_1, + author = {G. S. Winckelmans and A. Leonard}, + title = {Contributions to vortex particle methods for the computation of 3-dimensional incompressible unsteady flows}, + publisher = {Academic Press Inc. JNL-Comp Subscriptions}, + journal = {Journal Of Computational Physics}, + volume = {109}, + number = {2}, + pages = {247-273}, + year = {1993}, + issn = {00219991, 10902716} +} + +@article{Branlard15_1, +author = {E. Branlard and G. Papadakis and M. Gaunaa and G. Winckelmans and T. J. Larsen}, +title = {Aeroelastic large eddy simulations using vortex methods: unfrozen turbulent and sheared inflow}, +journal = {Journal of Physics: Conference Series (Online)}, +year = {2015}, +doi = {10.1088/1742-6596/625/1/012019}, +volume = {625}, +issn = {1742-6596}, +} + +@book{Branlard17_1, + author = {E. Branlard}, + title = {Wind Turbine Aerodynamics and Vorticity-Based Methods: Fundamentals and Recent Applications}, + year = {2017}, + publisher= {Springer International Publishing}, + doi={10.1007/978-3-319-55164-7}, + isbn={ 978-3-319-55163-0} +} + +@TECHREPORT{Garrel03_1, + author = {A. van Garrel}, + title = {Development of a Wind Turbine Aerodynamics Simulation Module}, + institution = {ECN}, + year = {2003}, + number = {ECN-C--03-079} +} + +@TECHREPORT{Kerwin:lecturenotes, + author = {J. Kerwin}, + title = {Lecture Notes Hydrofoil and propellers}, + institution = {M.I.T.}, + year = {2000} +} diff --git a/docs/source/user/aerodyn-olaf/index.rst b/docs/source/user/aerodyn-olaf/index.rst new file mode 100644 index 0000000000..e706234e7e --- /dev/null +++ b/docs/source/user/aerodyn-olaf/index.rst @@ -0,0 +1,36 @@ +.. _OLAF: + +OLAF User's Guide and Theory Manual (Free Vortex Wake in AeroDyn15) +=================================================================== + +.. only:: html + + This document offers a quick reference guide for the free vortex wake module + named OLAF that is included in the AeroDyn module of OpenFAST. It is + intended to be used by the general user in combination with other features + of AeroDyn and other OpenFAST modules. The manual will be updated as new + releases are issued and as needed to provide further information on + advancements or modifications to the software. + + The documentaiton here was derived from the OLAF users manual by K. Shaler, + E. Branlard, and A. Platt. (`https://www.nrel.gov/docs/fy20osti/75959.pdf + `_) + + +.. toctree:: + :maxdepth: 2 + + Introduction.rst + Acronyms.rst + RunningOLAF.rst + InputFiles.rst + OutputFiles.rst + OLAFTheory.rst + StateSpace.rst + FutureWork.rst + zrefs.rst + AppendixA.rst + AppendixB.rst + AppendixC.rst + +.. Acknowledgments.rst diff --git a/docs/source/user/aerodyn-olaf/zrefs.rst b/docs/source/user/aerodyn-olaf/zrefs.rst new file mode 100644 index 0000000000..dd7761ff6b --- /dev/null +++ b/docs/source/user/aerodyn-olaf/zrefs.rst @@ -0,0 +1,10 @@ +.. only:: html + + References + ---------- + +.. bibliography:: bibliography.bib + :labelprefix: olaf- + :keyprefix: olaf- + + diff --git a/docs/source/user/aerodyn/ADNodalOutputs.rst b/docs/source/user/aerodyn/ADNodalOutputs.rst new file mode 100644 index 0000000000..075561c13b --- /dev/null +++ b/docs/source/user/aerodyn/ADNodalOutputs.rst @@ -0,0 +1,41 @@ + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`AD-Outputs` above, AeroDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the AeroDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades AeroDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +AeroDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by AeroDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **AxInd** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###AxInd** where :math:`\mathbf{\beta}` is the blade number, and **###** is +the three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:ADNodalOutputs + + .. literalinclude:: examples/NodalOutputs.txt + :linenos: diff --git a/docs/source/user/aerodyn/examples/NodalOutputs.txt b/docs/source/user/aerodyn/examples/NodalOutputs.txt new file mode 100644 index 0000000000..2e1f3ec9b2 --- /dev/null +++ b/docs/source/user/aerodyn/examples/NodalOutputs.txt @@ -0,0 +1,58 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-) +"VUndx" - x-component of undisturbed wind velocity at each node +"VUndy" - y-component of undisturbed wind velocity at each node +"VUndz" - z-component of undisturbed wind velocity at each node +"VDisx" - x-component of disturbed wind velocity at each node +"VDisy" - y-component of disturbed wind velocity at each node +"VDisz" - z-component of disturbed wind velocity at each node +"STVx" - x-component of structural translational velocity at each node +"STVy" - y-component of structural translational velocity at each node +"STVz" - z-component of structural translational velocity at each node +"VRel" - Relvative wind speed at each node +"DynP" - Dynamic pressure at each node +"Re" - Reynolds number (in millions) at each node +"M" - Mach number at each node +"Vindx" - Axial induced wind velocity at each node +"Vindy" - Tangential induced wind velocity at each node +"AxInd" - Axial induction factor at each node +"TnInd" - Tangential induction factor at each node +"Alpha" - Angle of attack at each node +"Theta" - Pitch+Twist angle at each node +"Phi" - Inflow angle at each node +"Curve" - Curvature angle at each node +"Cl" - Lift force coefficient at each node +"Cd" - Drag force coefficient at each node +"Cm" - Pitching moment coefficient at each node +"Cx" - Normal force (to plane) coefficient at each node +"Cy" - Tangential force (to plane) coefficient at each node +"Cn" - Normal force (to chord) coefficient at each node +"Ct" - Tangential force (to chord) coefficient at each node +"Fl" - Lift force per unit length at each node +"Fd" - Drag force per unit length at each node +"Mm" - Pitching moment per unit length at each node +"Fx" - Normal force (to plane) per unit length at each node +"Fy" - Tangential force (to plane) per unit length at each node +"Fn" - Normal force (to chord) per unit length at each node +"Ft" - Tangential force (to chord) per unit length at each node +"Clrnc" - Tower clearance at each node (based on the absolute distance to the nearest point in the tower from blade node B#N# minus the local tower radius, in the deflected configuration); please note that this clearance is only approximate because the calculation assumes that the blade is a line with no volume (however, the calculation does use the local tower radius); when blade node B#N# is above the tower top (or below the tower base), the absolute distance to the tower top (or base) minus the local tower radius, in the deflected configuration, is output +"Vx" - Local axial velocity +"Vy" - Local tangential velocity +"GeomPhi" - Geometric phi? If phi was solved using normal BEMT equations, GeomPhi = 1; otherwise, if it was solved geometrically, GeomPhi = 0. +"Chi" - Skew angle (used in skewed wake correction) -- not available for OLAF +"UA_Flag" - Flag indicating if UA is turned on for this node. -- not available for OLAF +"CpMin" - Pressure coefficient +"SgCav" - Cavitation number +"SigCr" - Critical cavitation number +"Gam" - Gamma -- circulation on blade +"Cl_Static" - Static portion of lift force coefficient at each node, without unsteady effects -- not available for BEMT/DBEMT +"Cd_Static" - Static portion of drag force coefficient at each node, without unsteady effects -- not available for BEMT/DBEMT +"Cm_Static" - Static portion of pitching moment coefficient at each node, without unsteady effects -- not available for BEMT/DBEMT +"Uin" - Axial induced velocity in rotating hub coordinates. Axial aligned with hub axis. rotor plane polar hub rotating coordinates +"Uit" - Tangential induced velocity in rotating hub coordinates. Tangential to the rotation plane. Perpendicular to blade aziumth. rotor plane polar hub rotating coordinates +"Uir" - Radial induced velocity in rotating hub coordinates. Radial outwards in rotation plane. Aligned with blade azimuth. rotor plane polar hub rotating coordinates +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index d4e6b5a685..029f3b7773 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -10,6 +10,8 @@ False TwrShadow - Calculate tower influence on wind based on do False TwrAero - Calculate tower aerodynamic loads? (flag) False FrozenWake - Assume frozen wake during linearization? (flag) [used only when WakeMod=1 and when linearizing] False CavitCheck - Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true] +False CompAA - Flag to compute AeroAcoustics calculation [only used when WakeMod=1 or 2] +"unused" AA_InputFile - Aeroacoustics input file ====== Environmental Conditions =================================================================== 1.246 AirDens - Air density (kg/m^3) 1.4639E-05 KinVisc - Kinematic air viscosity (m^2/s) @@ -30,8 +32,10 @@ True TIDrag - Include the drag term in the tangential-induc ====== Dynamic Blade-Element/Momentum Theory Options ============================================== [used only when WakeMod=2] 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] +====== OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ================== [used only when WakeMod=3] +"unused" OLAFInputFileName - Input file for OLAF [used only when WakeMod=3] ====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options ===================================== [used only when AFAeroMod=2] - 1 UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] + 1 UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] FALSE FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2] ====== Airfoil Information ========================================================================= 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) @@ -82,5 +86,19 @@ True SumPrint - Generate a summary file listing input option "B1N1AxInd, B1N2AxInd, B1N3AxInd" "B1N1Alpha, B1N2Alpha, B1N3Alpha" "B1N1Theta, B1N2Theta, B1N3Theta" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- +END of OutList section (the word "END" must appear in the first 3 columns of the last OutList line) +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section] + 1 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) + "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"Fx, Fy" +"Vx, Vy" +Vrel +TnInd +AxInd +Theta +Phi +Vindx +Vindy +Alpha +END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index 71c8f87b7e..736ff09492 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -10,10 +10,11 @@ file is required. This driver file specifies initialization inputs normally provided to AeroDyn by OpenFAST, as well as the per-time-step inputs to AeroDyn. -As an example, the ``driver.dvr`` file is the main driver, the ``input.dat`` is the primary input file, the ``blade.dat`` file contains the blade -geometry data, and the ``airfoil.dat`` file contains the airfoil -angle of attack, lift, drag, moment coefficients, and pressure -coefficients. Example input files are included in :numref:`ad_appendix`. +As an example, the ``driver.dvr`` file is the main driver, the ``input.dat`` is +the primary input file, the ``blade.dat`` file contains the blade geometry data, +and the ``airfoil.dat`` file contains the airfoil angle of attack, lift, drag, +moment coefficients, and pressure coefficients. Example input files are +included in :numref:`ad_appendix`. No lines should be added or removed from the input files, except in tables where the number of rows is specified and comment lines in the @@ -151,10 +152,13 @@ for ``DTAero`` may be used to indicate that AeroDyn should employ the time step prescribed by the driver code (OpenFAST or the standalone driver program). -Set ``WakeMod`` to 0 if you want to disable rotor wake/induction -effects or 1 to include these effects using the BEM theory model. When -``WakeMod`` is set to 2, a dynamic BEM theory model (DBEMT) is used. -``WakeMod`` cannot be set to 2 during linearization analyses. +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 +to 3, the free vortex wake model is used, also referred to as OLAF (see +:numref:`OLAF`). ``WakeMod`` cannot be set to 2 or 3 during linearization +analyses. Set ``AFAeroMod`` to 1 to include steady blade airfoil aerodynamics or 2 to enable UA; ``AFAeroMod`` must be 1 during linearization analyses @@ -186,6 +190,15 @@ turbines or FALSE to disable this calculation. If ``CavitCheck`` is TRUE, ``AFAeroMod`` must be set to 1 because the cavitation check does not function with unsteady airfoil aerodynamics. +Set the ``CompAA`` flag to TRUE to run aero-acoustic calculations. This +option is only available for ``WakeMod = 1`` or ``2``. See section +:numref:`AeroAcoustics` for information on how to use this feature. + +The ``AA_InputFile`` is used to specify the input file for the aeroacoustics +sub-module. See :numref:`AeroAcoustics` for information on how to use this +feature. + + Environmental Conditions ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -257,6 +270,16 @@ to use a model where tau1 varies with time. If ``DBEMT_Mod=1`` (constant-tau1 model), set ``tau1_const`` to the time constant to use for DBEMT. +OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The input parameters in this section are used only when ``WakeMod = 3``. + +The settings for the free vortex wake model are set in the OLAF input file +described in :numref:`OLAF-Input-Files`. ``OLAFInputFileName`` is the filename +for this input file. + + Unsteady Airfoil Aerodynamics Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -360,6 +383,8 @@ specifies the local tower drag-force coefficient. ``TwrElev`` must be entered in monotonically increasing order—from the lowest (tower-base) to the highest (tower-top) elevation. See Figure 2. +.. _AD-Outputs: + Outputs ~~~~~~~ @@ -414,6 +439,11 @@ unknown/invalid channel name, it warns the users but will remove the suspect channel from the output file. Please refer to Appendix E for a complete list of possible output parameters. +.. _AD-Nodal-Outputs: + +.. include:: ADNodalOutputs.rst + + .. _airfoil_data_input_file: Airfoil Data Input File diff --git a/docs/source/user/aerodyn/modeling.rst b/docs/source/user/aerodyn/modeling.rst index c52ce72cc4..5b36deec1f 100644 --- a/docs/source/user/aerodyn/modeling.rst +++ b/docs/source/user/aerodyn/modeling.rst @@ -79,8 +79,8 @@ particular issue for full-field wind file formats). Model Options Under Operational and Parked/Idling Conditions ------------------------------------------------------------ -To model an operational rotor, we recommend to include induction -(``WakeMod = 1``) and UA (``AFAeroMod = 2``). Normally, the Pitt and +To model an operational rotor, we recommend to include the dynamic BEM model +(``WakeMod = 2``) and UA (``AFAeroMod = 2``). Normally, the Pitt and Peters skewed-wake (``SkewMod = 2``), Prandtl tip-loss (``TipLoss = TRUE``), Prandtl hub-loss (``HubLoss = TRUE``), and tangential induction (``TanInd = TRUE``) models should all be enabled, but diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index dfbc57dd9d..2a37dd7f3f 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -9,6 +9,35 @@ The changes are tabulated according to the module input file, line number, and f The line number corresponds to the resulting line number after all changes are implemented. Thus, be sure to implement each in order so that subsequent line numbers are correct. +OpenFAST v2.3.0 to OpenFAST `dev` +--------------------------------- + +============== ==== ================== ============================================================================================================================================================================= +Added in OpenFAST `dev` +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + Module Line Flag Name Example Value +============== ==== ================== ============================================================================================================================================================================= +HydroDyn 53 ExctnMod 0 ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (-) +OpenFAST 44 CalcSteady true CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) +OpenFAST 45 TrimCase 3 TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) +OpenFAST 46 TrimTol 0.0001 TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) +OpenFAST 47 TrimGain 0.001 TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) +OpenFAST 48 Twr_Kdmp 0 Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) +OpenFAST 49 Bld_Kdmp 0 Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) +InflowWind 48 InitPosition(x) 0.0 InitPosition(x) - Initial offset in +x direction (shift of wind box) [Only used with WindType = 5] (m) +AeroDyn 13 CompAA False CompAA - Flag to compute AeroAcoustics calculation [only used when WakeMod=1 or 2] +AeroDyn 14 AA_InputFile "unused" AA_InputFile - Aeroacoustics input file +AeroDyn 35 [separator line] ====== OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ================== [used only when WakeMod=3] +AeroDyn 36 OLAFInputFileName "Elliptic_OLAF.dat" OLAFInputFileName - Input file for OLAF [used only when WakeMod=3] +AirFoilTables 4\* BL_file "unused" BL_file - The file name including the boundary layer characteristics of the profile. Ignored if the aeroacoustic module is not called. + +============== ==== ================== ============================================================================================================================================================================= + +\*non-comment line count + +Additional nodal output channels added for :ref:`AeroDyn15`, +:ref:`BeamDyn`, and :ref:`ElastoDyn`. + OpenFAST v2.2.0 to OpenFAST v2.3.0 ---------------------------------- @@ -27,24 +56,26 @@ Added in OpenFAST v2.3.0 Module Line Flag Name Example Value ============================================= ==== =============== ======================================================================================================================================================================================================== AeroDyn Airfoil Input File - Airfoil Tables 2 UserProp 0 UserProp ! User property (control) setting -AeroDyn 37 AFTabMod 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) +AeroDyn 37 AFTabMod 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) ============================================= ==== =============== ======================================================================================================================================================================================================== - OpenFAST v2.1.0 to OpenFAST v2.2.0 ---------------------------------- No changes required. - OpenFAST v2.0.0 to OpenFAST v2.1.0 ---------------------------------- -No changes required. - - +============== ==== ================== ===================================================================================================================================================================== + Added in OpenFAST v2.1.0 +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + Module Line Flag Name Example Value +============== ==== ================== ===================================================================================================================================================================== +BeamDyn driver 21 GlbRotBladeT0 True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? +============== ==== ================== ===================================================================================================================================================================== OpenFAST v1.0.0 to OpenFAST v2.0.0 ---------------------------------- @@ -63,17 +94,17 @@ Added in OpenFAST v2.0.0 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value ========= ==== ================== ===================================================================================================================================================================== -AeroDyn 22 SkewModFactor "default" SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0] +AeroDyn 22 SkewModFactor "default" SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0] AeroDyn 30 Section header ====== Dynamic Blade-Element/Momentum Theory Options ============================================== [used only when WakeMod=2] -AeroDyn 31 DBEMT_Mod 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] -AeroDyn 32 tau1_const 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] -BeamDyn 5 QuasiStaticInit True QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only] -BeamDyn 11 load_retries DEFAULT load_retries - Number of factored load retries before quitting the aimulation +AeroDyn 31 DBEMT_Mod 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] +AeroDyn 32 tau1_const 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] +BeamDyn 5 QuasiStaticInit True QuasiStaticInit - Use quasi-static pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only] +BeamDyn 11 load_retries DEFAULT load_retries - Number of factored load retries before quitting the simulation BeamDyn 14 tngt_stf_fd DEFAULT tngt_stf_fd - Flag to use finite differenced tangent stiffness matrix (-) BeamDyn 15 tngt_stf_comp DEFAULT tngt_stf_comp - Flag to compare analytical finite differenced tangent stiffness matrix (-) BeamDyn 16 tngt_stf_pert DEFAULT tngt_stf_pert - perturbation size for finite differencing (-) BeamDyn 17 tngt_stf_difftol DEFAULT tngt_stf_difftol - Maximum allowable relative difference between analytical and fd tangent stiffness (-) -BeamDyn 18 RotStates True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] +BeamDyn 18 RotStates True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] ========= ==== ================== ===================================================================================================================================================================== @@ -100,6 +131,6 @@ Module Line Flag Name Example Value OpenFAST 18 CompSub 0 CompSub - Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=External Platform MCKF} AeroDyn 12 CavityCheck False CavitCheck - Perform cavitation check? (flag) AeroDyn 17 Patm 9999.9 Patm - Atmospheric pressure (Pa) [used only when CavitCheck=True] -AeroDyn 18 Pvap 9999.9 Pvap - Vapour pressure of fluid (Pa) [used only when CavitCheck=True] +AeroDyn 18 Pvap 9999.9 Pvap - Vapor pressure of fluid (Pa) [used only when CavitCheck=True] AeroDyn 19 FluidDepth 9999.9 FluidDepth - Water depth above mid-hub height (m) [used only when CavitCheck=True] ========== ==== =============== ==================================================================================================== diff --git a/docs/source/user/beamdyn/BDNodalOutputs.rst b/docs/source/user/beamdyn/BDNodalOutputs.rst new file mode 100644 index 0000000000..6a13a4654d --- /dev/null +++ b/docs/source/user/beamdyn/BDNodalOutputs.rst @@ -0,0 +1,39 @@ + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`BD-Outputs` above, BeamDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the BeamDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +BeamDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by BeamDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDxr** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDxr** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:BDNodalOutputs + + .. literalinclude:: examples/NodalOutputs.txt + :linenos: + + diff --git a/docs/source/user/beamdyn/appendix.rst b/docs/source/user/beamdyn/appendix.rst index 5412962c4b..41f3023cb6 100644 --- a/docs/source/user/beamdyn/appendix.rst +++ b/docs/source/user/beamdyn/appendix.rst @@ -13,8 +13,7 @@ In this appendix we describe the BeamDyn input-file structure and provide exampl OpenFAST+BeamDyn and stand-alone BeamDyn (static and dynamic) simulations all require two files: 1) BeamDyn primary input file -:download:`(NREL 5MW dynamic example) `, -:download:`(NREL 5MW static example) `: This file includes information on the analysis type (static vs. dynamic), numerical-solution parameters (e.g., numerical damping, quadrature rules), and the geometric definition of the beam reference line via "members" and "key points". This file also specifies the "blade input file." +:download:`(NREL 5MW static example) `: This file includes information on the numerical-solution parameters (e.g., numerical damping, quadrature rules), and the geometric definition of the beam reference line via "members" and "key points". This file also specifies the "blade input file." 2) BeamDyn blade input file :download:`(NREL 5MW example) `: @@ -22,7 +21,7 @@ Stand-alone BeamDyn simulation also require a driver input file; we list here ex 3a) BeamDyn driver for dynamic simulations :download:`(NREL 5MW example) `: This file specifies the inputs for a single blade (e.g., forces, orientations, root velocity) and specifies the BeamDyn primary input file. -3b) BeamDyn driver for static simulations :download:`(NREL 5MW example) `: Same as above but calls the appropriate inputs and primary input file (i.e., here one for static analysis). +3b) BeamDyn driver for static simulations :download:`(NREL 5MW example) `: Same as above but for static analysis. .. _app-output-channel: diff --git a/docs/source/user/beamdyn/examples/NodalOutputs.txt b/docs/source/user/beamdyn/examples/NodalOutputs.txt new file mode 100644 index 0000000000..7a260bc694 --- /dev/null +++ b/docs/source/user/beamdyn/examples/NodalOutputs.txt @@ -0,0 +1,138 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, BeamDyn_Nodes tab for a listing of available output channels, (-) +"FxL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"FyL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"FzL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"MxL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"MyL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"MzL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"Fxr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Fyr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Fzr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Mxr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"Myr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"Mzr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"TDxr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TDyr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TDzr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"RDxr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"RDyr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"RDzr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"AbsXg" - Node position in X (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsYg" - Node position in Y (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsZg" - Node position in Z (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsXr" - Node position in X (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"AbsYr" - Node position in Y (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"AbsZr" - Node position in Z (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TVxg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVyg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVzg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVxl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVyl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVzl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVxr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"TVyr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"TVzr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"RVxg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVyg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVzg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"RVyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"RVzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"TAxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"TAyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"TAzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"RAxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"RAyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"RAzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"PFxL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PFyL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PFzL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PMxL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"PMyL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"PMzL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"DFxL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DFyL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DFzL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DMxL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DMyL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DMzL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DFxR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DFyR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DFzR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DMxR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"DMyR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"DMzR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"FFbxl" - Gyroscopic force x l: a floating coordinate system local to the deflected beam (N) +"FFbyl" - Gyroscopic force y l: a floating coordinate system local to the deflected beam (N) +"FFbzl" - Gyroscopic force z l: a floating coordinate system local to the deflected beam (N) +"FFbxr" - Gyroscopic force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFbyr" - Gyroscopic force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFbzr" - Gyroscopic force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFbxl" - Gyroscopic moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFbyl" - Gyroscopic moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFbzl" - Gyroscopic moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFbxr" - Gyroscopic moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFbyr" - Gyroscopic moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFbzr" - Gyroscopic moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFcxl" - Elastic restoring force Fc x l: a floating coordinate system local to the deflected beam (N) +"FFcyl" - Elastic restoring force Fc y l: a floating coordinate system local to the deflected beam (N) +"FFczl" - Elastic restoring force Fc z l: a floating coordinate system local to the deflected beam (N) +"FFcxr" - Elastic restoring force Fc x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFcyr" - Elastic restoring force Fc y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFczr" - Elastic restoring force Fc z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFcxl" - Elastic restoring moment Fc about x l: a floating coordinate system local to the deflected beam (N-m) +"MFcyl" - Elastic restoring moment Fc about y l: a floating coordinate system local to the deflected beam (N-m) +"MFczl" - Elastic restoring moment Fc about z l: a floating coordinate system local to the deflected beam (N-m) +"MFcxr" - Elastic restoring moment Fc about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFcyr" - Elastic restoring moment Fc about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFczr" - Elastic restoring moment Fc about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFdxl" - Elastic restoring force Fd x l: a floating coordinate system local to the deflected beam (N) +"FFdyl" - Elastic restoring force Fd y l: a floating coordinate system local to the deflected beam (N) +"FFdzl" - Elastic restoring force Fd z l: a floating coordinate system local to the deflected beam (N) +"FFdxr" - Elastic restoring force Fd x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFdyr" - Elastic restoring force Fd y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFdzr" - Elastic restoring force Fd z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFdxl" - Elastic restoring moment Fd about x l: a floating coordinate system local to the deflected beam (N-m) +"MFdyl" - Elastic restoring moment Fd about y l: a floating coordinate system local to the deflected beam (N-m) +"MFdzl" - Elastic restoring moment Fd about z l: a floating coordinate system local to the deflected beam (N-m) +"MFdxr" - Elastic restoring moment Fd about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFdyr" - Elastic restoring moment Fd about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFdzr" - Elastic restoring moment Fd about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFgxl" - Gravity force x l: a floating coordinate system local to the deflected beam (N) +"FFgyl" - Gravity force y l: a floating coordinate system local to the deflected beam (N) +"FFgzl" - Gravity force z l: a floating coordinate system local to the deflected beam (N) +"FFgxr" - Gravity force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFgyr" - Gravity force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFgzr" - Gravity force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFgxl" - Gravity moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFgyl" - Gravity moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFgzl" - Gravity moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFgxr" - Gravity moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFgyr" - Gravity moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFgzr" - Gravity moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFixl" - Inertial force x l: a floating coordinate system local to the deflected beam (N) +"FFiyl" - Inertial force y l: a floating coordinate system local to the deflected beam (N) +"FFizl" - Inertial force z l: a floating coordinate system local to the deflected beam (N) +"FFixr" - Inertial force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFiyr" - Inertial force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFizr" - Inertial force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFixl" - Inertial moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFiyl" - Inertial moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFizl" - Inertial moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFixr" - Inertial moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFiyr" - Inertial moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFizr" - Inertial moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp index df2cca9641..4ce490dc66 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp @@ -14,14 +14,15 @@ True DynamicSolve - Dynamic solve (false for static solve) (-) 0 GlbPos(2) - Component of position vector of the reference blade frame along Y direction (m) 1 GlbPos(3) - Component of position vector of the reference blade frame along Z direction (m) ---The following 3 by 3 matrix is the direction cosine matirx ,GlbDCM(3,3), ----relates global frame to reference blade frame +---relates global frame to the initial blade root frame 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 +True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? ---------------------- ROOT VELOCITY PARAMETER ---------------------------------- - 1.0006 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) - 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) - 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) + 1.0006 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) + 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) + 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) ---------------------- APPLIED FORCE ---------------------------------- 0 DistrLoad(1) - Component of distributed force vector along X direction (N/m) 0 DistrLoad(2) - Component of distributed force vector along Y direction (N/m) @@ -39,5 +40,5 @@ True DynamicSolve - Dynamic solve (false for static solve) (-) Non-dim blade-span eta Fx Fy Fz Mx My Mz (-) (N) (N) (N) (N-m) (N-m) (N-m) ---------------------- PRIMARY INPUT FILE -------------------------------------- -"bd_primary_nrel_5mw_dynamic.inp" InputFile - Name of the primary BeamDyn input file +"bd_primary_nrel_5mw.inp" InputFile - Name of the primary BeamDyn input file diff --git a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp index 080cc927dc..3986048ac2 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp @@ -14,14 +14,15 @@ False DynamicSolve - Dynamic solve (false for static solve) (-) 0 GlbPos(2) - Component of position vector of the reference blade frame along Y direction (m) 1 GlbPos(3) - Component of position vector of the reference blade frame along Z direction (m) ---The following 3 by 3 matrix is the direction cosine matirx ,GlbDCM(3,3), ----relates global frame to reference blade frame +---relates global frame to the initial blade root frame 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 +True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? ---------------------- ROOT VELOCITY PARAMETER ---------------------------------- - 0 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) - 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) - 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) + 0 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) + 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) + 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) ---------------------- APPLIED FORCE ---------------------------------- 10000 DistrLoad(1) - Component of distributed force vector along X direction (N/m) 0 DistrLoad(2) - Component of distributed force vector along Y direction (N/m) @@ -39,5 +40,5 @@ False DynamicSolve - Dynamic solve (false for static solve) (-) Non-dim blade-span eta Fx Fy Fz Mx My Mz (-) (N) (N) (N) (N-m) (N-m) (N-m) ---------------------- PRIMARY INPUT FILE -------------------------------------- -"bd_primary_nrel_5mw_static.inp" InputFile - Name of the primary BeamDyn input file +"bd_primary_nrel_5mw.inp" InputFile - Name of the primary BeamDyn input file diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp similarity index 87% rename from docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp rename to docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 680db38b10..1fcd7475e1 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -2,13 +2,13 @@ NREL 5MW blade primary input file ---------------------- SIMULATION CONTROL -------------------------------------- TRUE Echo - Echo input data to ".ech"? (flag) -False QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] +False QuasiStaticInit - Use quasi-static pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] 0 rhoinf - Numerical damping parameter for generalized-alpha integrator 2 quadrature - Quadrature method: 1=Gaussian; 2=Trapezoidal (switch) "DEFAULT" refine - Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2] "DEFAULT" n_fact - Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5] "DEFAULT" DTBeam - Time step size (s) -"DEFAULT" load_retries - Number of factored load retries before quitting the aimulation [DEFAULT = 20] +"DEFAULT" load_retries - Number of factored load retries before quitting the simulation [DEFAULT = 20] "DEFAULT" NRMax - Max number of iterations in Newton-Raphson algorithm (-) [DEFAULT = 10] "DEFAULT" stop_tol - Tolerance for stopping criterion (-) [DEFAULT = 1E-5] FALSE tngt_stf_fd - Use finite differenced tangent stiffness matrix? (flag) @@ -92,5 +92,17 @@ True SumPrint - Print summary data to ".sum" (flag) "N1Mxl,N1Myl,N1Mzl" "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" +END of input file (the word "END" must appear in the first 3 columns of the last OutList line) +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== (optional section) + "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"TDxr, TDyr, TDzr" +"TVxr, TVyr, TVzr" +"TAxr, TAyr, TAzr" +"RDxr, RDyr, RDzr" +"RVxr, RVyr, RVzr" +"RAxr, RAyr, RAzr" +"Fxr, Fyr, Fzr" +"TipTDxr, TipTDyr, TipTDzr" +"TipRDxr, TipRDyr, TipRDzr" END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp deleted file mode 100644 index 680db38b10..0000000000 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp +++ /dev/null @@ -1,96 +0,0 @@ ---------- BEAMDYN with OpenFAST INPUT FILE ------------------------------------------- -NREL 5MW blade primary input file ----------------------- SIMULATION CONTROL -------------------------------------- -TRUE Echo - Echo input data to ".ech"? (flag) -False QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] - 0 rhoinf - Numerical damping parameter for generalized-alpha integrator - 2 quadrature - Quadrature method: 1=Gaussian; 2=Trapezoidal (switch) -"DEFAULT" refine - Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2] -"DEFAULT" n_fact - Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5] -"DEFAULT" DTBeam - Time step size (s) -"DEFAULT" load_retries - Number of factored load retries before quitting the aimulation [DEFAULT = 20] -"DEFAULT" NRMax - Max number of iterations in Newton-Raphson algorithm (-) [DEFAULT = 10] -"DEFAULT" stop_tol - Tolerance for stopping criterion (-) [DEFAULT = 1E-5] -FALSE tngt_stf_fd - Use finite differenced tangent stiffness matrix? (flag) -FALSE tngt_stf_comp - Compare analytical finite differenced tangent stiffness matrix? (flag) -"DEFAULT" tngt_stf_pert - Perturbation size for finite differencing (-) [DEFAULT = 1E-6] -"DEFAULT" tngt_stf_difftol - Maximum allowable relative difference between analytical and fd tangent stiffness (-); [DEFAULT = 0.1] -True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] ----------------------- GEOMETRY PARAMETER -------------------------------------- - 1 member_total - Total number of members (-) - 49 kp_total - Total number of key points (-) [must be at least 3] - 1 49 - Member number; Number of key points in this member - kp_xr kp_yr kp_zr initial_twist - (m) (m) (m) (deg) -0.0000000E+00 0.0000000E+00 0.0000000E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.9987500E-01 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.1998650E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 2.1998550E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 3.1998450E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 4.1998350E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 5.1998250E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 6.1998150E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 7.1998050E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 8.2010250E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 9.1997850E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.0199775E+01 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.1199765E+01 1.3181000E+01 -0.0000000E+00 0.0000000E+00 1.2199755E+01 1.2848000E+01 -0.0000000E+00 0.0000000E+00 1.3200975E+01 1.2192000E+01 -0.0000000E+00 0.0000000E+00 1.4199735E+01 1.1561000E+01 -0.0000000E+00 0.0000000E+00 1.5199725E+01 1.1072000E+01 -0.0000000E+00 0.0000000E+00 1.6199715E+01 1.0792000E+01 -0.0000000E+00 0.0000000E+00 1.8200925E+01 1.0232000E+01 -0.0000000E+00 0.0000000E+00 2.0200290E+01 9.6720000E+00 -0.0000000E+00 0.0000000E+00 2.2200270E+01 9.1100000E+00 -0.0000000E+00 0.0000000E+00 2.4200250E+01 8.5340000E+00 -0.0000000E+00 0.0000000E+00 2.6200230E+01 7.9320000E+00 -0.0000000E+00 0.0000000E+00 2.8200825E+01 7.3210000E+00 -0.0000000E+00 0.0000000E+00 3.0200190E+01 6.7110000E+00 -0.0000000E+00 0.0000000E+00 3.2200170E+01 6.1220000E+00 -0.0000000E+00 0.0000000E+00 3.4200150E+01 5.5460000E+00 -0.0000000E+00 0.0000000E+00 3.6200130E+01 4.9710000E+00 -0.0000000E+00 0.0000000E+00 3.8200725E+01 4.4010000E+00 -0.0000000E+00 0.0000000E+00 4.0200090E+01 3.8340000E+00 -0.0000000E+00 0.0000000E+00 4.2200070E+01 3.3320000E+00 -0.0000000E+00 0.0000000E+00 4.4200050E+01 2.8900000E+00 -0.0000000E+00 0.0000000E+00 4.6200030E+01 2.5030000E+00 -0.0000000E+00 0.0000000E+00 4.8201240E+01 2.1160000E+00 -0.0000000E+00 0.0000000E+00 5.0199990E+01 1.7300000E+00 -0.0000000E+00 0.0000000E+00 5.2199970E+01 1.3420000E+00 -0.0000000E+00 0.0000000E+00 5.4199950E+01 9.5400000E-01 -0.0000000E+00 0.0000000E+00 5.5199940E+01 7.6000000E-01 -0.0000000E+00 0.0000000E+00 5.6199930E+01 5.7400000E-01 -0.0000000E+00 0.0000000E+00 5.7199920E+01 4.0400000E-01 -0.0000000E+00 0.0000000E+00 5.7699915E+01 3.1900000E-01 -0.0000000E+00 0.0000000E+00 5.8201140E+01 2.5300000E-01 -0.0000000E+00 0.0000000E+00 5.8699905E+01 2.1600000E-01 -0.0000000E+00 0.0000000E+00 5.9199900E+01 1.7800000E-01 -0.0000000E+00 0.0000000E+00 5.9699895E+01 1.4000000E-01 -0.0000000E+00 0.0000000E+00 6.0199890E+01 1.0100000E-01 -0.0000000E+00 0.0000000E+00 6.0699885E+01 6.2000000E-02 -0.0000000E+00 0.0000000E+00 6.1199880E+01 2.3000000E-02 -0.0000000E+00 0.0000000E+00 6.1500000E+01 0.0000000E+00 ----------------------- MESH PARAMETER ------------------------------------------ - 5 order_elem - Order of interpolation (basis) function (-) ----------------------- MATERIAL PARAMETER -------------------------------------- -"nrel_5mw_blade.inp" BldFile - Name of file containing properties for blade (quoted string) ----------------------- PITCH ACTUATOR PARAMETERS ------------------------------- -False UsePitchAct - Whether a pitch actuator should be used (flag) - 200 PitchJ - Pitch actuator inertia (kg-m^2) [used only when UsePitchAct is true] - 2E+07 PitchK - Pitch actuator stiffness (kg-m^2/s^2) [used only when UsePitchAct is true] - 500000 PitchC - Pitch actuator damping (kg-m^2/s) [used only when UsePitchAct is true] ----------------------- OUTPUTS ------------------------------------------------- -True SumPrint - Print summary data to ".sum" (flag) -"ES10.3E2" OutFmt - Format used for text tabular output, excluding the time channel. - 2 NNodeOuts - Number of nodes to output to file [0 - 9] (-) - 1, 3 OutNd - Nodes whose values will be output (-) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) -"RootFxr, RootFyr, RootFzr" -"RootMxr, RootMyr, RootMzr" -"N1Fxl,N1Fyl,N1Fzl" -"N1Mxl,N1Myl,N1Mzl" -"TipTDxr, TipTDyr, TipTDzr" -"TipRDxr, TipRDyr, TipRDzr" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp b/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp index 6dce8bcaf4..24e2192f2a 100644 --- a/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp +++ b/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp @@ -6,7 +6,7 @@ ---------------------- DAMPING COEFFICIENT------------------------------------ mu1 mu2 mu3 mu4 mu5 mu6 (-) (-) (-) (-) (-) (-) -1.0E-03 1.0E-03 1.0E-03 1.0E-03 1.0E-03 1.0E-03 +1.0E-03 1.0E-03 1.0E-03 0.0014 0.0022 0.0022 ---------------------- DISTRIBUTED PROPERTIES--------------------------------- 0.000000 9.729480E+08 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 diff --git a/docs/source/user/beamdyn/future_work.rst b/docs/source/user/beamdyn/future_work.rst index 495994fc44..5caef1945f 100644 --- a/docs/source/user/beamdyn/future_work.rst +++ b/docs/source/user/beamdyn/future_work.rst @@ -1,4 +1,4 @@ -.. _future-work: +.. _bd-future-work: Future Work =========== diff --git a/docs/source/user/beamdyn/input_files.rst b/docs/source/user/beamdyn/input_files.rst index d7bdc2fbdb..f5802607ef 100644 --- a/docs/source/user/beamdyn/input_files.rst +++ b/docs/source/user/beamdyn/input_files.rst @@ -1,4 +1,4 @@ -.. _input-files: +.. _bd-input-files: Input Files =========== @@ -415,6 +415,8 @@ actuator, whereby the pitch angular orientation, velocity, and acceleration are determined by the actuator based on the input blade-pitch angle prescribed by the driver code. +.. _BD-Outputs: + Outputs ~~~~~~~ @@ -461,6 +463,10 @@ remove the suspect channel from the output file. Please refer to Appendix :numref:`app-output-channel` for a complete list of possible output parameters and their names. +.. _BD-Nodal-Outputs: + +.. include:: BDNodalOutputs.rst + Blade Input File ---------------- diff --git a/docs/source/user/beamdyn/introduction.rst b/docs/source/user/beamdyn/introduction.rst index 3f6b8b5d30..95e54cfc36 100644 --- a/docs/source/user/beamdyn/introduction.rst +++ b/docs/source/user/beamdyn/introduction.rst @@ -103,9 +103,9 @@ independent between BeamDyn and AeroDyn. This document is organized as follows. Section :ref:`running-beamdyn` details how to obtain the BeamDyn and FAST software archives and run either the stand-alone version of BeamDyn or BeamDyn coupled to FAST. -Section :ref:`input-files` describes the BeamDyn input files. -Section :ref:`output-files` discusses the output files generated by +Section :ref:`bd-input-files` describes the BeamDyn input files. +Section :ref:`bd-output-files` discusses the output files generated by BeamDyn. Section :ref:`beamdyn-theory` summarizes the BeamDyn theory. -Section :ref:`future-work` outlines potential future work. Example input +Section :ref:`bd-future-work` outlines potential future work. Example input files are shown in Appendix :numref:`bd_input_files`. A summary of available output channels is found in Appendix :ref:`app-output-channel`. diff --git a/docs/source/user/beamdyn/output_files.rst b/docs/source/user/beamdyn/output_files.rst index dfbf5b2e87..82a13535fd 100644 --- a/docs/source/user/beamdyn/output_files.rst +++ b/docs/source/user/beamdyn/output_files.rst @@ -1,4 +1,4 @@ -.. _output-files: +.. _bd-output-files: Output Files ============ diff --git a/docs/source/user/beamdyn/running_bd.rst b/docs/source/user/beamdyn/running_bd.rst index 0f3d93cfc6..a2885315fc 100644 --- a/docs/source/user/beamdyn/running_bd.rst +++ b/docs/source/user/beamdyn/running_bd.rst @@ -62,7 +62,7 @@ use of a driver file in addition to the primary and blade BeamDyn input files. This driver file specifies inputs normally provided to BeamDyn by FAST, including motions of the blade root and externally applied loads. Both the BeamDyn summary file and the results output file are available -when using the stand-alone BeamDyn (see Section :ref:`output-files` for +when using the stand-alone BeamDyn (see Section :ref:`bd-output-files` for more information regarding the BeamDyn output files). Run the stand-alone BeamDyn software from a DOS command prompt by diff --git a/docs/source/user/beamdyn/theory.rst b/docs/source/user/beamdyn/theory.rst index 390ad0b03d..15ccb380b3 100644 --- a/docs/source/user/beamdyn/theory.rst +++ b/docs/source/user/beamdyn/theory.rst @@ -18,7 +18,7 @@ underlines only denote the dimension of the corresponding matrix. Coordinate Systems ------------------ -:numref:`blade-geometry` (in :numref:`input-files`) and +:numref:`blade-geometry` (in :numref:`bd-input-files`) and :numref:`bd-frame` show the coordinate system used in BeamDyn. .. _bd-frame: diff --git a/docs/source/user/elastodyn/EDNodalOutputs.rst b/docs/source/user/elastodyn/EDNodalOutputs.rst new file mode 100644 index 0000000000..6c0a4abd22 --- /dev/null +++ b/docs/source/user/elastodyn/EDNodalOutputs.rst @@ -0,0 +1,41 @@ + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`ED-Outputs` above, ElastoDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the ElastoDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades ElastoDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +ElastoDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by ElastoDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDx** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDx** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:EDNodalOutputs + + .. literalinclude:: exampleInput/NodalOutpus.txt + :linenos: diff --git a/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt b/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt new file mode 100644 index 0000000000..db15b8e793 --- /dev/null +++ b/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt @@ -0,0 +1,26 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"ALx" - local flapwise acceleration (absolute) of node +"ALy" - local flapwise acceleration (absolute) of node +"ALz" - local flapwise acceleration (absolute) of node +"TDx" - local flapwise (translational) deflection (relative to the undeflected position) of node +"TDy" - local edgewise (translational) deflection (relative to the undeflected position) of node +"TDz" - local axial (translational) deflection (relative to the undeflected position) of node +"RDx" - Local rotational displacement about x-axis (relative to undeflected) +"RDy" - Local rotational displacement about y-axis (relative to undeflected) +"RDz" - Local rotational displacement about z-axis (relative to undeflected) +"MLx" - local edgewise moment at node +"MLy" - local flapwise moment at node +"MLz" - local pitching moment at node +"FLx" - local flapwise shear force at node +"FLy" - local edgewise shear force at node +"FLz" - local axial force at node +"MLxNT" - Edgewise moment in local coordinate system (initial structural twist removed) +"MlyNT" - Flapwise shear moment in local coordinate system (initial structural twist removed) +"FLxNT" - Flapwise shear force in local coordinate system (initial structural twist removed) +"FlyNT" - Edgewise shear force in local coordinate system (initial structural twist removed) +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/elastodyn/index.rst b/docs/source/user/elastodyn/index.rst new file mode 100644 index 0000000000..d3ef2bdb8c --- /dev/null +++ b/docs/source/user/elastodyn/index.rst @@ -0,0 +1,18 @@ +ElastoDyn Users Guide and Theory Manual +======================================= + +.. only:: html + + This document offers a quick reference guide for the ElastoDyn software + program. It is intended to be used by the general user in combination + with other OpenFAST manuals. The manual will be updated as new releases are + issued and as needed to provide further information on advancements or + modifications to the software. + + The documentation here is incomplete. + + +.. toctree:: + + input.rst + diff --git a/docs/source/user/elastodyn/input.rst b/docs/source/user/elastodyn/input.rst new file mode 100644 index 0000000000..14e7accc13 --- /dev/null +++ b/docs/source/user/elastodyn/input.rst @@ -0,0 +1,366 @@ +.. _ed_input: + +Input Files +=========== + +The user configures the structural model parameters via a primary ElastoDyn +input file, as well as separate input files for the tower and *other stuff that +will be documented here later.* + +No lines should be added or removed from the input files. + +Units +----- + +ElastoDyn uses the SI system (kg, m, s, N). Angles are assumed to be in +radians unless otherwise specified. + +ElastoDyn Primary Input File +---------------------------- + +The primary ElastoDyn input file defines modeling options and geometries for the +OpenFAST structure including the tower, nacelle, drivetrain, and blades (if +BeamDyn is not used). It also sets the initial conditions for the structure. + +Simulation Control +~~~~~~~~~~~~~~~~~~ + +Set the **Echo** flag to TRUE if you wish to have ElastoDyn echo the +contents of the ElastoDyn primary, airfoil, and blade input files (useful +for debugging errors in the input files). The echo file has the naming +convention of *OutRootFile.ED.ech*. **OutRootFile** is either +specified in the I/O SETTINGS section of the driver input file when +running ElastoDyn standalone, or by the OpenFAST program when running a +coupled simulation. + +**Method** + +**dT** + +Environmental Condition +~~~~~~~~~~~~~~~~~~~~~~~ + +**gravity** + +Degrees of Freedom +~~~~~~~~~~~~~~~~~~ + +**FlapDOF1** - First flapwise blade mode DOF (flag) + +**FlapDOF2** - Second flapwise blade mode DOF (flag) + +**EdgeDOF** - First edgewise blade mode DOF (flag) + +**TeetDOF** - Rotor-teeter DOF (flag) [unused for 3 blades] + +**DrTrDOF** - Drivetrain rotational-flexibility DOF (flag) + +**GenDOF** - Generator DOF (flag) + +**YawDOF** - Yaw DOF (flag) + +**TwFADOF1** - First fore-aft tower bending-mode DOF (flag) + +**TwFADOF2** - Second fore-aft tower bending-mode DOF (flag) + +**TwSSDOF1** - First side-to-side tower bending-mode DOF (flag) + +**TwSSDOF2** - Second side-to-side tower bending-mode DOF (flag) + +**PtfmSgDOF** - Platform horizontal surge translation DOF (flag) + +**PtfmSwDOF** - Platform horizontal sway translation DOF (flag) + +**PtfmHvDOF** - Platform vertical heave translation DOF (flag) + +**PtfmRDOF** - Platform roll tilt rotation DOF (flag) + +**PtfmPDOF** - Platform pitch tilt rotation DOF (flag) + +**PtfmYDOF** - Platform yaw rotation DOF (flag) + + + +Initial Conditions +~~~~~~~~~~~~~~~~~~ + +**OoPDefl** - Initial out-of-plane blade-tip displacement (meters) + +**IPDefl** - Initial in-plane blade-tip deflection (meters) + +**BlPitch(1)** - Blade 1 initial pitch (degrees) + +**BlPitch(2)** - Blade 2 initial pitch (degrees) + +**BlPitch(3)** - Blade 3 initial pitch (degrees) [unused for 2 blades] + +**TeetDefl** - Initial or fixed teeter angle (degrees) [unused for 3 blades] + +**Azimuth** - Initial azimuth angle for blade 1 (degrees) + +**RotSpeed** - Initial or fixed rotor speed (rpm) + +**NacYaw** - Initial or fixed nacelle-yaw angle (degrees) + +**TTDspFA** - Initial fore-aft tower-top displacement (meters) + +**TTDspSS** - Initial side-to-side tower-top displacement (meters) + +**PtfmSurge** - Initial or fixed horizontal surge translational displacement of platform (meters) + +**PtfmSway** - Initial or fixed horizontal sway translational displacement of platform (meters) + +**PtfmHeave** - Initial or fixed vertical heave translational displacement of platform (meters) + +**PtfmRoll** - Initial or fixed roll tilt rotational displacement of platform (degrees) + +**PtfmPitch** - Initial or fixed pitch tilt rotational displacement of platform (degrees) + +**PtfmYaw** - Initial or fixed yaw rotational displacement of platform (degrees) + +Turbine Configuration +~~~~~~~~~~~~~~~~~~~~~ + +**NumBl** - Number of blades (-) + +**TipRad** - The distance from the rotor apex to the blade tip (meters) + +**HubRad** - The distance from the rotor apex to the blade root (meters) + +**PreCone(1)** - Blade 1 cone angle (degrees) + +**PreCone(2)** - Blade 2 cone angle (degrees) + +**PreCone(3)** - Blade 3 cone angle (degrees) [unused for 2 blades] + +**HubCM** - Distance from rotor apex to hub mass [positive downwind] (meters) + +**UndSling** - Undersling length [distance from teeter pin to the rotor apex] (meters) [unused for 3 blades] + +**Delta3** - Delta-3 angle for teetering rotors (degrees) [unused for 3 blades] + +**AzimB1Up** - Azimuth value to use for I/O when blade 1 points up (degrees) + +**OverHang** - Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters) + +**ShftGagL** - Distance from rotor apex [3 blades] or teeter pin [2 blades] to shaft strain gages [positive for upwind rotors] (meters) + +**ShftTilt** - Rotor shaft tilt angle (degrees) + +**NacCMxn** - Downwind distance from the tower-top to the nacelle CM (meters) + +**NacCMyn** - Lateral distance from the tower-top to the nacelle CM (meters) + +**NacCMzn** - Vertical distance from the tower-top to the nacelle CM (meters) + +**NcIMUxn** - Downwind distance from the tower-top to the nacelle IMU (meters) + +**NcIMUyn** - Lateral distance from the tower-top to the nacelle IMU (meters) + +**NcIMUzn** - Vertical distance from the tower-top to the nacelle IMU (meters) + +**Twr2Shft** - Vertical distance from the tower-top to the rotor shaft (meters) + +**TowerHt** - Height of tower above ground level [onshore] or MSL [offshore] (meters) + +**TowerBsHt** - Height of tower base above ground level [onshore] or MSL [offshore] (meters) + +**PtfmCMxt** - Downwind distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmCMyt** - Lateral distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmCMzt** - Vertical distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmRefzt** - Vertical distance from the ground level [onshore] or MSL [offshore] to the platform reference point (meters) + + + +Mass and Inertia +~~~~~~~~~~~~~~~~ + +**TipMass(1)** - Tip-brake mass, blade 1 (kg) + +**TipMass(2)** - Tip-brake mass, blade 2 (kg) + +**TipMass(3)** - Tip-brake mass, blade 3 (kg) [unused for 2 blades] + +**HubMass** - Hub mass (kg) + +**HubIner** - Hub inertia about rotor axis [3 blades] or teeter axis [2 blades] (kg m^2) + +**GenIner** - Generator inertia about HSS (kg m^2) + +**NacMass** - Nacelle mass (kg) + +**NacYIner** - Nacelle inertia about yaw axis (kg m^2) + +**YawBrMass** - Yaw bearing mass (kg) + +**PtfmMass** - Platform mass (kg) + +**PtfmRIner** - Platform inertia for roll tilt rotation about the platform CM (kg m^2) + +**PtfmPIner** - Platform inertia for pitch tilt rotation about the platform CM (kg m^2) + +**PtfmYIner** - Platform inertia for yaw rotation about the platform CM (kg m^2) + + + +Blade +~~~~~ + +**BldNodes** - Number of blade nodes (per blade) used for analysis (-) + +**BldFile(1)** - Name of file containing properties for blade 1 (quoted string) + +**BldFile(2)** - Name of file containing properties for blade 2 (quoted string) + +**BldFile(3)** - Name of file containing properties for blade 3 (quoted string) [unused for 2 blades] + + +Rotor-Teeter +~~~~~~~~~~~~ + +**TeetMod** - Rotor-teeter spring/damper model {0: none, 1: standard, 2: user-defined from routine UserTeet} (switch) [unused for 3 blades] + +**TeetDmpP** - Rotor-teeter damper position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetDmp** - Rotor-teeter damping constant (N-m/(rad/s)) [used only for 2 blades and when TeetMod=1] + +**TeetCDmp** - Rotor-teeter rate-independent Coulomb-damping moment (N-m) [used only for 2 blades and when TeetMod=1] + +**TeetSStP** - Rotor-teeter soft-stop position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetHStP** - Rotor-teeter hard-stop position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetSSSp** - Rotor-teeter soft-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] + +**TeetHSSp** - Rotor-teeter hard-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] + + + +Drivetrain +~~~~~~~~~~ + +**GBoxEff** - Gearbox efficiency (%) + +**GBRatio** - Gearbox ratio (-) + +**DTTorSpr** - Drivetrain torsional spring (N-m/rad) + +**DTTorDmp** - Drivetrain torsional damper (N-m/(rad/s)) + + + +Furling +~~~~~~~ + +**Furling** - Read in additional model properties for furling turbine (flag) [must currently be FALSE) + +**FurlFile** - Name of file containing furling properties (quoted string) [unused when Furling=False] + + +Tower +~~~~~ + +**TwrNodes** - Number of tower nodes used for analysis (-) + +**TwrFile** - Name of file containing tower properties (quoted string) + + +.. _ED-Outputs: + +Outputs +~~~~~~~ + +**SumPrint** [flag] Set this value to TRUE if you want ElastoDyn to generate a +summary file with the name **OutFileRoot**.ED.sum*. **OutFileRoot** is specified +by the OpenFAST program when running a coupled simulation. + +**OutFile** [switch] is currently unused. The eventual purpose is to allow +output from ElastoDyn to be written to a module output file (option 1), or the +main OpenFAST output file (option 2), or both. At present this switch is +ignored. + +**TabDelim** [flag] is currently unused. Setting this to True will set the +delimeter for text files to the tab character for the ElastoDyn module +**OutFile**. + +**OutFmt** [quoted string] is currently unused. ElastoDyn will use this string +as the numerical format specifier for output of floating-point values in its +local output specified by **OutFile**. The length of this string must not exceed +20 characters and must be enclosed in apostrophes or double quotes. You may not +specify an empty string. To ensure that fixed-width column data align properly +with the column titles, you should ensure that the width of the field is 10 +characters. Using an E, EN, or ES specifier will guarantee that you will never +overflow the field because the number is too big, but such numbers are harder to +read. Using an F specifier will give you numbers that are easier to read, but +you may overflow the field. Please refer to any Fortran manual for details for +format specifiers. + +**TStart** [s] sets the start time for **OutFile**. This is currenlty unused. + +**DecFact** [-] This parameter sets the decimation factor for output. ElastoDyn +will output data to **OutFile** only once each DecFact integration time steps. +For instance, a value of 5 will cause FAST to generate output only every fifth +time step. This value must be an integer greater than zero. + +**NTwGages** [-] The number of strain-gage locations along the tower indicates +the number of input values on the next line. Valid values are integers from 0 to +5 (inclusive). + +**TwrGagNd** [-] The virtual strain-gage locations along the tower are assigned +to the tower analysis nodes specified on this line. Possible values are 1 to +TwrNodes (inclusive), where 1 corresponds to the node closest to the tower base +(but not at the base) and a value of TwrNodes corresponds to the node closest to +the tower top. The exact elevations of each analysis node in the undeflected +tower, relative to the base of the tower, are determined as follows: + + Elev. of node J = TwrRBHt + ( J – 1⁄2 ) • [ ( TowerHt + TwrDraft – TwrRBHt ) / TwrNodes ] + (for J = 1,2,...,TwrNodes) + +You must enter at least NTwGages values on this line. +If NTwGages is 0, this line will be skipped, but you must have a line taking up +space in the input file. You can separate the values with combinations of tabs, +spaces, and commas, but you may use only one comma between numbers. + +**NBlGages** [-] specifies the number of strain-gague locations along the blade, +and indicates the number of input values expected in **BldGagNd**. This is only +used when the blade structure is modeled in ElastoDyn. + +**BldGagNd** [-] specifies the virtual strain-gage locations along the blade +that should be output. Possible values are 1 to **BldNodes** (inclusive), where +1 corresponds to the node closest to the blade root (but not at the root) and a +value of BldNodes corresponds to the node closest to the blade tip. The node +locations are specified by the ElastoDyn blade input files. You must enter at +least NBlGages values on this line. If NBlGages is 0, this line will be skipped, +but you must have a line taking up space in the input file. You can separate the +values with combinations of tabs, spaces, and commas, but you may use only one +comma between numbers. This is only used when the blade structure is modeled in +ElastoDyn. + + +The **OutList** section controls output quantities generated by +ElastoDyn. Enter one or more lines containing quoted strings that in turn +contain one or more output parameter names. Separate output parameter +names by any combination of commas, semicolons, spaces, and/or tabs. If +you prefix a parameter name with a minus sign, “-”, underscore, “_”, or +the characters “m” or “M”, ElastoDyn will multiply the value for that +channel by –1 before writing the data. The parameters are written in the +order they are listed in the input file. ElastoDyn allows you to use +multiple lines so that you can break your list into meaningful groups +and so the lines can be shorter. You may enter comments after the +closing quote on any of the lines. Entering a line with the string “END” +at the beginning of the line or at the beginning of a quoted string +found at the beginning of the line will cause ElastoDyn to quit scanning +for more lines of channel names. Blade and tower node-related quantities +are generated for the requested nodes identified through the +**BldGagNd** and **TwrGagNd** lists above. If ElastoDyn encounters an +unknown/invalid channel name, it warns the users but will remove the +suspect channel from the output file. Please refer to the ElastoDyn tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +.. _ED-Nodal-Outputs: + +.. include:: EDNodalOutputs.rst diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 125a16da8e..0cf94cb104 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -14,7 +14,10 @@ Details on the transition from FAST v8 to OpenFAST may be found in :numref:`fast api_change.rst aerodyn/index.rst + aerodyn-olaf/index.rst + aerodyn-aeroacoustics/index.rst beamdyn/index.rst + elastodyn/index.rst fast_to_openfast.rst cppapi/index.rst diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 10b16e85e3..c2901fec4f 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -232,7 +232,7 @@ void fast::OpenFAST::step() { // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: // (note OpenFOAM could do subcycling around this step) - //writeVelocityData(velNodeDataFile, iTurb, nt_global, cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); + writeVelocityData(velNodeDataFile, iTurb, nt_global, cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); if ( isDebug() ) { diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index ef0d4b1d70..990b6b4964 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -37,7 +37,7 @@ PROGRAM FAST ! Local parameters: REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time -INTEGER(IntKi), PARAMETER :: NumTurbines = 1 +INTEGER(IntKi), PARAMETER :: NumTurbines = 1 ! Note that CalcSteady linearization analysis and WrVTK_Modes should be performed with only 1 turbine ! Other/Misc variables TYPE(FAST_TurbineType) :: Turbine(NumTurbines) ! Data for each turbine instance @@ -45,7 +45,7 @@ PROGRAM FAST INTEGER(IntKi) :: i_turb ! current turbine number INTEGER(IntKi) :: n_t_global ! simulation time step, loop counter for global (FAST) simulation INTEGER(IntKi) :: ErrStat ! Error status -CHARACTER(1024) :: ErrMsg ! Error message +CHARACTER(ErrMsgLen) :: ErrMsg ! Error message ! data for restart: CHARACTER(1000) :: InputFile ! String to hold the intput file name @@ -53,6 +53,7 @@ PROGRAM FAST CHARACTER(20) :: FlagArg ! flag argument from command line INTEGER(IntKi) :: Restart_step ! step to start on (for restart) + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! determine if this is a restart from checkpoint !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -63,12 +64,22 @@ PROGRAM FAST CALL CheckArgs( InputFile, Flag=FlagArg, Arg2=CheckpointRoot ) - IF ( TRIM(FlagArg) == 'H' ) THEN ! Exit after help prompt + IF ( TRIM(FlagArg) == 'RESTART' ) THEN ! Restart from checkpoint file + CALL FAST_RestoreFromCheckpoint_Tary(t_initial, Restart_step, Turbine, CheckpointRoot, ErrStat, ErrMsg ) + CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + + ELSE IF ( TRIM(FlagArg) == 'VTKLIN' ) THEN ! Read checkpoint file to output linearization analysis, but don't continue time-marching + CALL FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, CheckpointRoot, ErrStat, ErrMsg ) + CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint for mode shapes' ) + + ! Note that this works only when NumTurbines==1 (we don't have files for each of the turbines...) + Restart_step = Turbine(1)%p_FAST%n_TMax_m1 + 1 + CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) + + ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() - ELSE IF ( TRIM(FlagArg) == 'RESTART' ) THEN ! Restart from checkpoint file - CALL FAST_RestoreFromCheckpoint_Tary(t_initial, Restart_step, Turbine, CheckpointRoot, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + ELSE Restart_step = 0 @@ -108,13 +119,13 @@ PROGRAM FAST ! Time Stepping: !............................................................................................................................... - DO n_t_global = Restart_step, Turbine(1)%p_FAST%n_TMax_m1 +TIME_STEP_LOOP: DO n_t_global = Restart_step, Turbine(1)%p_FAST%n_TMax_m1 ! bjj: we have to make sure the n_TMax_m1 and n_ChkptTime are the same for all turbines or have some different logic here ! write checkpoint file if requested - IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global) then + IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global .and. .not. Turbine(1)%m_FAST%Lin%FoundSteady) then CheckpointRoot = TRIM(Turbine(1)%p_FAST%OutFileRoot)//'.'//TRIM(Num2LStr(n_t_global)) CALL FAST_CreateCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg) @@ -128,7 +139,7 @@ PROGRAM FAST ! this takes data from n_t_global and gets values at n_t_global + 1 DO i_turb = 1,NumTurbines - + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(i_turb), ErrStat, ErrMsg ) CALL CheckError( ErrStat, ErrMsg ) @@ -138,12 +149,16 @@ PROGRAM FAST CALL FAST_Linearize_T(t_initial, n_t_global+1, Turbine(i_turb), ErrStat, ErrMsg) CALL CheckError( ErrStat, ErrMsg ) + IF ( Turbine(i_turb)%m_FAST%Lin%FoundSteady) EXIT TIME_STEP_LOOP END DO - - - END DO ! n_t_global + END DO TIME_STEP_LOOP ! n_t_global + DO i_turb = 1,NumTurbines + if ( Turbine(i_turb)%p_FAST%CalcSteady .and. .not. Turbine(i_turb)%m_FAST%Lin%FoundSteady) then + CALL CheckError( ErrID_Fatal, "Unable to find steady-state solution." ) + end if + END DO !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Write simulation times and stop diff --git a/glue-codes/simulink/src/create_FAST_SFunc.m b/glue-codes/simulink/src/create_FAST_SFunc.m index 4c52505fba..f97fb2b41e 100644 --- a/glue-codes/simulink/src/create_FAST_SFunc.m +++ b/glue-codes/simulink/src/create_FAST_SFunc.m @@ -1,7 +1,7 @@ %% INSTRUCTIONS % Before running this script, you must have compiled OpenFAST for Simulink to create a DLL (i.e., a shared library like .so, .dylib, .lib, etc.). % - If cmake was used, make sure the install directory is specified properly in the `installDir` variable below, -% and set `built_with_visualStudio` to false (necessary on Windows only). +% and if using Windows, set `built_with_visualStudio` to false. % - If the Visual Studio Solution file contained in the vs-build directory was used to create the DLL on Windows, % make sure `built_with_visualStudio` is set to true. % - The name of the library that was generated must match the `libname` variable below diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index db590322c8..5e426d99ac 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -15,33 +15,82 @@ # if (GENERATE_TYPES) + generate_f90_types(src/AeroAcoustics_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroAcoustics_Types.f90) generate_f90_types(src/AeroDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Types.f90) generate_f90_types(src/AirfoilInfo_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AirfoilInfo_Types.f90) generate_f90_types(src/BEMT_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/BEMT_Types.f90) generate_f90_types(src/DBEMT_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/DBEMT_Types.f90) generate_f90_types(src/UnsteadyAero_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/UnsteadyAero_Types.f90) generate_f90_types(src/AeroDyn_Driver_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Driver_Types.f90 -noextrap) + generate_f90_types(src/FVW_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/FVW_Types.f90) endif() + +# AeroAcoustics - Main +set(AEROACOUSTIC_SOURCES + src/AeroAcoustics_TNO.f90 + src/AeroAcoustics.f90 + src/AeroAcoustics_IO.f90 + src/AeroAcoustics_Types.f90 +) + # AeroDyn lib set(AD_LIBS_SOURCES src/AeroDyn.f90 src/AeroDyn_IO.f90 - src/AirfoilInfo.f90 + src/AeroDyn_AllBldNdOuts_IO.f90 src/BEMT.f90 src/DBEMT.f90 src/BEMTUncoupled.f90 - src/UnsteadyAero.f90 src/mod_root1dim.f90 src/AeroDyn_Types.f90 - src/AirfoilInfo_Types.f90 src/BEMT_Types.f90 src/DBEMT_Types.f90 +) + +# UnsteadyAero lib +set(UA_LIBS_SOURCES + src/UnsteadyAero.f90 src/UnsteadyAero_Types.f90 ) +# AirFoil Info lib +set(AFINFO_LIBS_SOURCES + src/AirfoilInfo.f90 + src/AirfoilInfo_Types.f90 +) + +# FVW lib +set(FVW_LIBS_SOURCES + src/FVW.f90 + src/FVW_IO.f90 + src/FVW_VortexTools.f90 + src/FVW_Wings.f90 + src/FVW_Subs.f90 + src/FVW_BiotSavart.f90 + src/FVW_Tests.f90 + src/FVW_Types.f90 + src/FVW_VTK.f90 +) + +# UnsteadyAero lib +add_library(uaaerolib ${UA_LIBS_SOURCES}) +target_link_libraries(uaaerolib afinfolib nwtclibs) + +# AirfoilInfo lib +add_library(afinfolib ${AFINFO_LIBS_SOURCES}) +target_link_libraries(afinfolib nwtclibs) + +# this lib is only for the ctest +add_library(fvwlib ${FVW_LIBS_SOURCES}) +target_link_libraries(fvwlib uaaerolib afinfolib nwtclibs) + +# Aero acoustics +add_library(aeroacoustics ${AEROACOUSTIC_SOURCES}) +target_link_libraries(aeroacoustics afinfolib nwtclibs) + add_library(aerodynlib ${AD_LIBS_SOURCES}) -target_link_libraries(aerodynlib nwtclibs) +target_link_libraries(aerodynlib fvwlib uaaerolib afinfolib nwtclibs aeroacoustics) # AeroDyn driver set(AD_DRIVER_SOURCES @@ -51,7 +100,7 @@ set(AD_DRIVER_SOURCES ) add_executable(aerodyn_driver ${AD_DRIVER_SOURCES}) -target_link_libraries(aerodyn_driver aerodynlib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) +target_link_libraries(aerodyn_driver aerodynlib fvwlib uaaerolib afinfolib nwtclibs versioninfolib aeroacoustics ${CMAKE_DL_LIBS}) # UnsteadyAero driver set(UA_DRIVER_SOURCES @@ -59,9 +108,9 @@ set(UA_DRIVER_SOURCES src/UA_Dvr_Subs.f90 ) add_executable(unsteadyaero_driver ${UA_DRIVER_SOURCES}) -target_link_libraries(unsteadyaero_driver aerodynlib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) +target_link_libraries(unsteadyaero_driver aerodynlib fvwlib uaaerolib afinfolib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) -install(TARGETS unsteadyaero_driver aerodyn_driver aerodynlib +install(TARGETS unsteadyaero_driver aerodyn_driver aerodynlib fvwlib uaaerolib afinfolib aeroacoustics EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 new file mode 100644 index 0000000000..429b8edd92 --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -0,0 +1,2468 @@ +!********************************************************************************************************************************** +! File last committed: 2020-02-12 +!********************************************************************************************************************************** +module AeroAcoustics + + use NWTC_Library + use AeroAcoustics_Types + use AeroAcoustics_IO + use NWTC_LAPACK + USE NWTC_FFTPACK + implicit none + + private + ! ..... Public Subroutines ................................................................................................... + public :: AA_Init ! Initialization routine + public :: AA_End ! Ending routine (includes clean up) + public :: AA_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + public :: AA_CalcOutput ! Routine for computing outputs + + contains +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The parameters are set here and not changed during the simulation. +!! The initial states and initial guess for the input are defined. +subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) + type(AA_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(AA_ParameterType), intent( out) :: p !< Parameters + type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states + type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + type(AA_MiscVarType), intent( out) :: m !< Initial misc/optimization variables + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + !! (1) AA_UpdateStates() is called in loose coupling & + !! (2) AA_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. + type(AA_InitOutputType), intent( out) :: InitOut !< Output for initialization routine + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + 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 + integer(IntKi) :: UnEcho ! Unit number for the echo file + character(*), parameter :: RoutineName = 'AA_Init' + + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + UnEcho = -1 + ! Initialize the NWTC Subroutine Library + call NWTC_Init( EchoLibVer=.FALSE. ) + ! Display the module information + call DispNVD( AA_Ver ) + + ! To get rid of a compiler warning. + x%DummyContState = 0.0_SiKi + z%DummyConstrState = 0.0_SiKi + OtherState%DummyOtherState = 0.0_SiKi + + !bjj: note that we haven't validated p%NumBlades before using it below! + p%NumBlades = InitInp%NumBlades ! need this before reading the AD input file so that we know how many blade files to read + p%RootName = TRIM(InitInp%RootName)//'.NN' + + ! 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 ) + if (Failed()) return + + ! Validate the inputs + call ValidateInputData(InputFileData, p%NumBlades, ErrStat2, ErrMsg2); if (Failed()) return + + ! Validate Initialization Input data ( not found in the AeroAcoustics input file ) + if (InitInp%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The air density (AirDens) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%KinVisc <= 0.0) call SetErrStat ( ErrID_Fatal, 'The kinesmatic viscosity (KinVisc) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%SpdSound <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (Failed()) return + + ! 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 + + ! Define outputs here + call Init_y(y, u, p, errStat2, errMsg2); if(Failed()) return + + ! Initialize states and misc vars + call Init_MiscVars(m, p, u, y, errStat2, errMsg2); if(Failed()) return + call Init_States(xd, p, errStat2, errMsg2); if(Failed()) return + + ! Define initialization output here + call AA_SetInitOut(p, InputFileData, InitOut, errStat2, errMsg2); if(Failed()) return + call AA_InitializeOutputFile(p, InputFileData,InitOut,errStat2, errMsg2); if(Failed()) return + 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 AA_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) + IF ( UnEcho > 0 ) CLOSE( UnEcho ) + end subroutine Cleanup +end subroutine AA_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets AeroAcoustics parameters for use during the simulation; these variables are not changed after AA_Init. +subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) + TYPE(AA_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below + TYPE(AA_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements + TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! Local variables + 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) :: I,J,whichairfoil,K + character(*), parameter :: RoutineName = 'SetParameters' + LOGICAL :: tr,tri,exist + REAL(ReKi) :: val1,val2,f2,f4,lefttip,rightip,jumpreg + ! Initialize variables for this routine + ErrStat = ErrID_None + ErrMsg = "" + !!Assign input fiel data to parameters + p%DT = InputFileData%DT_AA ! seconds + p%AA_Bl_Prcntge = InputFileData%AA_Bl_Prcntge ! % + p%fsample = 1/p%DT ! Hz + p%total_sample = 2**( ceiling(log(1*p%fsample)/log(2.0d0)))! 1 stands for the 1 seconds. Every 1 second Vrel spectra will be calculated for the dissipation calculation (change if more needed & recompile ) + p%total_sampleTI = 5/p%DT ! 10 seconds for TI sampling + p%AAStart = InputFileData%AAStart + p%IBLUNT = InputFileData%IBLUNT + p%ILAM = InputFileData%ILAM + p%ITIP = InputFileData%ITIP + p%ITRIP = InputFileData%ITRIP + p%ITURB = InputFileData%ITURB + p%IInflow = InputFileData%IInflow + p%X_BLMethod = InputFileData%X_BLMethod + p%TICalcMeth = InputFileData%TICalcMeth + p%AweightFlag = InputFileData%AweightFlag + p%ROUND = InputFileData%ROUND + p%alprat = InputFileData%ALPRAT + p%NrOutFile = InputFileData%NrOutFile + p%delim = Tab + p%outFmt = "ES15.6E3" + p%NumBlNds = InitInp%NumBlNds + p%AirDens = InitInp%AirDens + p%KinVisc = InitInp%KinVisc + p%SpdSound = InitInp%SpdSound + p%HubHeight = InitInp%HubHeight + p%z0_AA = InputFileData%z0_AA + p%dy_turb_in = InputFileData%dy_turb_in + p%dz_turb_in = InputFileData%dz_turb_in + p%NrObsLoc = InputFileData%NrObsLoc + p%FTitle = InputFileData%FTitle + + call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return + p%TI_Grid_In=InputFileData%TI_Grid_In + + ! Copy AFInfo into AA module + ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) + ALLOCATE(p%AFInfo( size(InitInp%AFInfo) ), STAT=ErrStat2) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName) + RETURN + ENDIF + + do i=1,size(InitInp%AFInfo) + call AFI_CopyParam(InitInp%AFInfo(i), p%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2); if(Failed()) return + end do + + ! Check 1 + tri=.true. + IF( (p%ITURB.eq.2) .or. (p%IInflow.gt.1) )then + ! if tno is on or one of the guidati models is on, check if we have airfoil coordinates + DO k=1,size(p%AFInfo) ! if any of the airfoil coordinates are missing change calculation method + IF( (size(p%AFInfo(k)%X_Coord) .lt. 5) .or. (size(p%AFInfo(k)%Y_Coord).lt.5) )then + IF (tri) then ! Print the message for once only + 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 ' + p%ITURB = 1 + p%IInflow = 1 + tri=.false. + ENDIF + ENDIF + ENDDO + ENDIF + + ! Check 2 + ! if passed the first check and if tno, turn on boundary layer calculation + IF( (p%ITURB.eq.2)) then + p%X_BLMethod=2 + ENDIF + + ! Check 3 + ! if boundary layer is tripped then laminar b.l. vortex shedding mechanism is turned off + IF( p%ITRIP.gt.0 )then + p%ILAM=0 + ENDIF + + ! set 1/3 octave band frequency as parameter and A weighting. + CALL AllocAry( p%FreqList, 34, 'FreqList', ErrStat2, ErrMsg2); if(Failed()) return + p%FreqList = (/10.,12.5,16.,20.,25.,31.5,40.,50.,63.,80., & + 100.,125.,160.,200.,250.,315.,400.,500.,630.,800., & + 1000.,1250.,1600.,2000.,2500.,3150.,4000.,5000.,6300.,8000., & + 10000.,12500.,16000.,20000./) ! TODO this should be fortran parameter + + + CALL AllocAry(p%Aweight, size(p%Freqlist), 'Aweight', ErrStat2, ErrMsg2); if(Failed()) return + Do I=1,size(p%Freqlist) + f2 = p%Freqlist(I)**2; + f4 = p%Freqlist(I)**4; + p%Aweight(I)= 10 * log(1.562339 * f4 / ((f2 + 107.65265**2) & + * (f2 + 737.86223 **2))) / log(10.0_Reki) & + + 10 * log(2.242881E+16 * f4 / ((f2 + 20.598997**2)**2 & + * (f2 + 12194.22**2)**2)) / log(10.0_Reki) + enddo + + ! Observer Locations + call AllocAry(p%ObsX, p%NrObsLoc, 'p%ObsX', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%ObsY, p%NrObsLoc, 'p%ObsY', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%ObsZ, p%NrObsLoc, 'p%ObsZ', ErrStat2, ErrMsg2); if(Failed()) return + p%ObsX = InputFileData%ObsX + p%ObsY = InputFileData%ObsY + p%ObsZ = InputFileData%ObsZ + ! + call AllocAry(p%BlAFID, p%NumBlNds, p%numBlades, 'p%BlAFID' , ErrStat2, ErrMsg2); if(Failed()) return + p%BlAFID=InitInp%BlAFID + + ! Blade Characteristics chord,span,trailing edge angle and thickness,airfoil ID for each segment + call AllocAry(p%TEThick ,p%NumBlNds,p%NumBlades,'p%TEThick' ,ErrStat2,ErrMsg2); if(Failed()) return + call AllocAry(p%TEAngle ,p%NumBlNds,p%NumBlades,'p%TEAngle' ,ErrStat2,ErrMsg2); if(Failed()) return + call AllocAry(p%StallStart,p%NumBlNds,p%NumBlades,'p%StallStart',ErrStat2,ErrMsg2); if(Failed()) return + p%StallStart(:,:) = 0.0_ReKi + + do i=1,p%NumBlades + p%TEThick(:,i) = InputFileData%BladeProps(i)%TEThick(:) ! + p%TEAngle(:,i) = InputFileData%BladeProps(i)%TEAngle(:) ! + do j=1,p%NumBlNds + whichairfoil = p%BlAFID(j,i) + if(p%AFInfo(whichairfoil)%NumTabs /=1 ) then + call SetErrStat(ErrID_Fatal, 'Number of airfoil tables within airfoil file different than 1, which is not supported.', ErrStat2, ErrMsg2, RoutineName ) + if(Failed()) return + endif + p%StallStart(j,i) = p%AFInfo(whichairfoil)%Table(1)%UA_BL%alpha1*180/PI ! approximate stall angle of attack [deg] (alpha1 in [rad]) + enddo + end do + + call AllocAry(p%BlSpn, p%NumBlNds, p%NumBlades, 'p%BlSpn' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlChord, p%NumBlNds, p%NumBlades, 'p%BlChord', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%AerCent, 2, p%NumBlNds, p%NumBlades, 'p%AerCent', ErrStat2, ErrMsg2); if(Failed()) return + p%BlSpn = InitInp%BlSpn + p%BlChord = InitInp%BlChord + + do j=p%NumBlNds,2,-1 + IF ( p%BlSpn(j,1) .lt. p%BlSpn(p%NumBlNds,1)*(100-p%AA_Bl_Prcntge)/100 )THEN ! assuming + p%startnode=j + exit ! exit the loop + endif + enddo + + IF (p%startnode.lt.2) THEN + p%startnode=2 + ENDIF + + !print*, 'AeroAcoustics Module is using the blade nodes starting from ' ,p%startnode,' Radius in meter ',p%BlSpn(p%startnode,1) + !AerodYnamic center extraction for each segment + do i=1,p%numBlades + do j=1,p%NumBlNds + whichairfoil = p%BlAFID(j,i) ! just a temporary variable for clear coding + ! airfoil coordinates read by AeroDyn. First value is the aerodynamic center + p%AerCent(1,J,I) = p%AFInfo(whichairfoil)%X_Coord(1) ! assigned here corresponding airfoil. + p%AerCent(2,J,I) = p%AFInfo(whichairfoil)%Y_Coord(1) ! assigned here corresponding airfoil. + enddo + enddo + + ! Dimensionalize Leading and trailing edge coordinates for later usage + call AllocAry( p%AFTeCo, 3, p%NumBlNds,p%numBlades, 'p%AFTeCo', errStat2, errMsg2 ); if(Failed())return + call AllocAry( p%AFLeCo, 3, p%NumBlNds,p%numBlades, 'p%AFLeCo', errStat2, errMsg2 ); if(Failed())return + p%AFTeCo=0.0_Reki + p%AFLeCo=0.0_Reki + + ! Normalized Leading edge coordinates (0,0,0) + ! Normalized Trailing edge coordinates (1,0,0) -- > changed to 0,1,0 + DO i=1,p%numBlades + DO j=1,p%NumBlNds + p%AFLeCo(1,j,i) = ( 0.0_Reki - p%AerCent(2,J,I) ) * p%BlChord(j,i) ! (y_LE - y_AC) *Chord + p%AFLeCo(2,j,i) = ( 0.0_Reki - p%AerCent(1,J,I) ) * p%BlChord(j,i) ! (x_LE - x_AC) *Chord + p%AFLeCo(3,j,i) = ( 0.0_Reki - 0.0_Reki ) * p%BlChord(j,i) ! this is always zero at the moment ( kept for 3d consistency ) + p%AFTeCo(1,j,i) = ( 0.0_Reki - p%AerCent(2,J,I) ) * p%BlChord(j,i) ! (y_TE - y_AC) *Chord + p%AFTeCo(2,j,i) = ( 1.0_Reki - p%AerCent(1,J,I) ) * p%BlChord(j,i) ! (x_TE - x_AC) *Chord + p%AFTeCo(3,j,i) = ( 0.0_Reki - 0.0_Reki ) * p%BlChord(j,i) ! this is always zero at the moment ( kept for 3d consistency ) + ENDDO + ENDDO + + if (p%X_BLMethod.eq.2) then + + ! Copying inputdata list of AOA and Reynolds to parameters + call AllocAry( p%AOAListBL, size(InputFileData%AOAListBL), 'p%AOAListBL', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%ReListBL, size(InputFileData%ReListBL) , 'p%ReListBL' , errStat2, errMsg2); if(Failed()) return + p%AOAListBL=InputFileData%AOAListBL + p%ReListBL=InputFileData%ReListBL + ! Allocate the suction and pressure side boundary layer parameters for output - will be used as tabulated data + call AllocAry(p%dstarall1 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%dstarall1' , errStat2, errMsg2); if(Failed()) return + call AllocAry(p%dstarall2 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%dstarall2' , errStat2, errMsg2); if(Failed()) return + call AllocAry(p%d99all1 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%d99all1' , errStat2, errMsg2); if(Failed()) return + call AllocAry(p%d99all2 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%d99all2' , errStat2, errMsg2); if(Failed()) return + call AllocAry(p%Cfall1 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%Cfall1' , errStat2, errMsg2); if(Failed()) return + call AllocAry(p%Cfall2 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%Cfall2' , errStat2, errMsg2); if(Failed()) return + call AllocAry(p%EdgeVelRat1,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%EdgeVelRat1', errStat2, errMsg2); if(Failed()) return + call AllocAry(p%EdgeVelRat2,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%EdgeVelRat2', errStat2, errMsg2); if(Failed()) return + p%dstarall1 =0.0_ReKi + p%dstarall2 =0.0_ReKi + p%d99all1 =0.0_ReKi + p%d99all2 =0.0_ReKi + p%Cfall1 =0.0_ReKi + p%Cfall2 =0.0_ReKi + p%EdgeVelRat1 =0.0_ReKi + p%EdgeVelRat2 =0.0_ReKi + + + ! --- BL data are read from files and just copy what was read from the files + p%dstarall1 = InputFileData%Suct_DispThick + p%dstarall2 = InputFileData%Pres_DispThick + p%d99all1 = InputFileData%Suct_BLThick + p%d99all2 = InputFileData%Pres_BLThick + p%Cfall1 = InputFileData%Suct_Cf + p%Cfall2 = InputFileData%Pres_Cf + p%EdgeVelRat1 = InputFileData%Suct_EdgeVelRat + p%EdgeVelRat2 = InputFileData%Pres_EdgeVelRat + + if(Failed()) return + endif + + ! If simplified guidati is on, calculate the airfoil thickness from input airfoil coordinates + IF (p%IInflow .EQ. 2) THEN + ! Calculate the Thickness @ 1% chord and @ 10% chord (normalized thickness) + call AllocAry(p%AFThickGuida,2,size(p%AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return + p%AFThickGuida=0.0_Reki + + DO k=1,size(p%AFInfo) ! for each airfoil interpolation + tri=.true.;tr=.true.; + do i=2,size(p%AFInfo(k)%X_Coord) + if ( (p%AFInfo(k)%X_Coord(i)+p%AFInfo(k)%Y_Coord(i)) .eq. 0) then + !print*,i + goto 174 + endif + if ( p%AFInfo(k)%X_Coord(i) .eq. 0.1) then + val1=p%AFInfo(k)%Y_Coord(i) + elseif ( (p%AFInfo(k)%X_Coord(i) .lt. 0.1) .and. (tri) ) then + val1=( abs(p%AFInfo(k)%X_Coord(i-1)-0.1)*p%AFInfo(k)%Y_Coord(i) + & + abs(p%AFInfo(k)%X_Coord(i)-0.1)*p%AFInfo(k)%Y_Coord(i-1))/ & + (abs(p%AFInfo(k)%X_Coord(i-1)-0.1)+abs(p%AFInfo(k)%X_Coord(i)-0.1)) + + tri=.false. + elseif (p%AFInfo(k)%X_Coord(i) .eq. 0.01) then + val2=p%AFInfo(k)%Y_Coord(i) + elseif ( (p%AFInfo(k)%X_Coord(i) .lt. 0.01) .and. (tr) ) then + val2=( abs(p%AFInfo(k)%X_Coord(i-1)-0.01)*p%AFInfo(k)%Y_Coord(i) + & + abs(p%AFInfo(k)%X_Coord(i)-0.01)*p%AFInfo(k)%Y_Coord(i-1))/ & + (abs(p%AFInfo(k)%X_Coord(i-1)-0.01)+abs(p%AFInfo(k)%X_Coord(i)-0.01)) + tr=.false. + endif + enddo + + 174 tri=.true.;tr=.true.; + do j=i,size(p%AFInfo(k)%X_Coord) + if ( p%AFInfo(k)%X_Coord(j) .eq. 0.1) then + val1=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val1) + elseif ( (p%AFInfo(k)%X_Coord(j) .gt. 0.1) .and. (tri) ) then + val1=abs(val1)+abs((abs(p%AFInfo(k)%X_Coord(j-1)-0.1)*p%AFInfo(k)%Y_Coord(j)+ & + abs(p%AFInfo(k)%X_Coord(j)-0.1)*p%AFInfo(k)%Y_Coord(j-1))/& + (abs(p%AFInfo(k)%X_Coord(j-1)-0.1)+abs(p%AFInfo(k)%X_Coord(j)-0.1))); + tri=.false. + elseif (p%AFInfo(k)%X_Coord(j) .eq. 0.01) then + val2=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val2) + elseif ( (p%AFInfo(k)%X_Coord(j) .gt. 0.01) .and. (tr) ) then + val2=abs(val2)+abs((abs(p%AFInfo(k)%X_Coord(j-1)-0.01)*p%AFInfo(k)%Y_Coord(j)+ & + abs(p%AFInfo(k)%X_Coord(j)-0.01)*p%AFInfo(k)%Y_Coord(j-1))/& + (abs(p%AFInfo(k)%X_Coord(j-1)-0.01)+abs(p%AFInfo(k)%X_Coord(j)-0.01))); + tr=.false. + endif + enddo + + p%AFThickGuida(1,k)=val2 ! 1 % chord thickness + p%AFThickGuida(2,k)=val1 ! 10 % chord thickness + ENDDO + ENDIF ! If simplified guidati is on, calculate the airfoil thickness + + !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided vertically to store flow fields in each region + jumpreg=7 + p%toptip = CEILING(p%HubHeight+maxval(p%BlSpn(:,1)))+2 !Top Tip Height = Hub height plus radius + p%bottip = FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))-2 !Bottom Tip Height = Hub height minus radius + call AllocAry(p%rotorregionlimitsVert,ceiling(((p%toptip)-(p%bottip))/jumpreg), 'p%rotorregionlimitsVert', errStat2, errMsg2); if(Failed()) return + do i=0,size(p%rotorregionlimitsVert)-1 + p%rotorregionlimitsVert(i+1)=(p%bottip)+jumpreg*i + enddo + !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided horizontally to store flow fields in each region + jumpreg=7 + lefttip = 2*maxval(p%BlSpn(:,1))+5 ! + rightip = 0 ! + call AllocAry( p%rotorregionlimitsHorz,ceiling(((lefttip)-(rightip))/jumpreg), 'p%rotorregionlimitsHorz', errStat2, errMsg2); if(Failed()) return + do i=0,size(p%rotorregionlimitsHorz)-1 + p%rotorregionlimitsHorz(i+1)=rightip+jumpreg*i + enddo + jumpreg=60 ! 10 ! must be divisable to 360 + call AllocAry(p%rotorregionlimitsalph,INT((360/jumpreg)+1), 'p%rotorregionlimitsalph', errStat2, errMsg2); if(Failed()) return + do i=0,size(p%rotorregionlimitsalph)-1 + p%rotorregionlimitsalph(i+1)=jumpreg*i + enddo + jumpreg=5 + call AllocAry( p%rotorregionlimitsrad, (CEILING( maxval(p%BlSpn(:,1))/jumpreg )+2), 'p%rotorregionlimitsrad', errStat2, errMsg2); if(Failed()) return + do i=1,size(p%rotorregionlimitsrad)-1 + p%rotorregionlimitsrad(i+1)=jumpreg*i + enddo + p%rotorregionlimitsrad(1)=0.0_reki + p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)=p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)+3 + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + 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 ) + 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 + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_u' + + call AllocAry(u%AoANoise , p%NumBlNds, p%numBlades, 'u%AoANoise', errStat2 , errMsg2); if(Failed()) return + call AllocAry(u%Vrel , p%NumBlNds, p%numBlades, 'u%Vrel' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(u%AeroCent_G, 3 , p%NumBlNds , p%numBlades , 'u%AeroCent_G', errStat2 , errMsg2); if(Failed()) return + call AllocAry(u%Inflow , 3_IntKi , p%NumBlNds , p%numBlades , 'u%Inflow' , ErrStat2 , ErrMsg2); if(Failed()) return + call AllocAry(u%RotGtoL , 3 , 3 , p%NumBlNds , p%numBlades , 'u%RotGtoL' , errStat2 , errMsg2); if(Failed()) return + u%AoANoise = 0.0_Reki + u%Vrel = 0.0_Reki + u%RotGtoL = 0.0_Reki + u%AeroCent_G = 0.0_Reki + u%Inflow = 0.0_Reki +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine Init_u +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes AeroAcoustics output array variables for use during the simulation. +subroutine Init_y(y, u, p, errStat, errMsg) + type(AA_OutputType), intent( out) :: y !< Module outputs + type(AA_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy + type(AA_ParameterType), intent(inout) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: k ! loop counter for blades + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_y' + integer(intKi) :: nNoiseMechanism ! loop counter for blades + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + nNoiseMechanism = 7! 7 noise mechanisms + p%numOuts = p%NrObsLoc + p%NumOutsForSep = p%NrObsLoc*size(p%FreqList)*nNoiseMechanism + p%NumOutsForPE = p%NrObsLoc*size(p%Freqlist) + p%NumOutsForNodes = p%NrObsLoc*p%NumBlNds*p%NumBlades + call AllocAry(y%WriteOutput , p%numOuts , 'y%WriteOutput' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%WriteOutputSep , p%NumOutsForSep , 'y%WriteOutputSep' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%WriteOutputForPE , p%numOutsForPE , 'y%WriteOutputForPE' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%DirectiviOutput , p%NrObsLoc , 'y%DirectiviOutput' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%WriteOutputNode , p%NumOutsForNodes , 'y%WriteOutputSepFreq' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%OASPL , p%NrObsLoc , p%NumBlNds , p%NumBlades , 'y%OASPL' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%SumSpecNoise , size(p%FreqList) , p%NrObsLoc , p%NumBlades , 'y%SumSpecNoise' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%SumSpecNoiseSep , 7 , p%NrObsLoc , size(p%FreqList) , 'y%SumSpecNoiseSep' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%OASPL_Mech , nNoiseMechanism , p%NrObsLoc , p%NumBlNds , p%NumBlades , 'y%OASPL_Mech' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%OutLECoords , 3 , size(p%FreqList) , p%NrObsLoc , p%NumBlades , 'y%OutLECoords' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%PtotalFreq , p%NrObsLoc , size(p%FreqList) , 'y%PtotalFreq' , errStat2 , errMsg2); if(Failed()) return + + y%WriteOutput = 0.0_reki + y%WriteOutputSep = 0.0_reki + y%WriteOutputForPE = 0.0_reki + y%DirectiviOutput = 0.0_reki + y%WriteOutputNode = 0.0_reki + y%OASPL = 0.0_reki + y%OASPL_Mech = 0.0_reki + y%SumSpecNoise = 0.0_reki + y%SumSpecNoiseSep = 0.0_reki + y%OutLECoords = 0.0_reki + y%PtotalFreq = 0.0_reki + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine Init_y +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes (allocates) the misc variables for use during the simulation. +subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) + type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) + type(AA_ParameterType), intent(in ) :: p !< Parameters + type(AA_InputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) + type(AA_OutputType), intent(in ) :: y !< output (create mapping between output and otherstate mesh here) + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: k + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_MiscVars' + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + call AllocAry(m%ChordAngleLE, p%NrObsLoc, p%NumBlNds, p%numBlades, 'ChordAngleLE', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(m%SpanAngleLE , p%NrObsLoc, p%NumBlNds, p%numBlades, 'SpanAngleLE' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(m%ChordAngleTE, p%NrObsLoc, p%NumBlNds, p%numBlades, 'ChordAngleTE', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(m%SpanAngleTE , p%NrObsLoc, p%NumBlNds, p%numBlades, 'SpanAngleTE' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(m%rTEtoObserve, p%NrObsLoc, p%NumBlNds, p%numBlades, 'rTEtoObserve', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(m%rLEtoObserve, p%NrObsLoc, p%NumBlNds, p%numBlades, 'rLEtoObserve', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(m%SPLLBL , size(p%FreqList), 'SPLLBL' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLP , size(p%FreqList), 'SPLP' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLS , size(p%FreqList), 'SPLS' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLALPH , size(p%FreqList), 'SPLALPH' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLTBL , size(p%FreqList), 'SPLTBL' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLBLUNT , size(p%FreqList), 'SPLBLUNT' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLTIP , size(p%FreqList), 'SPLTIP' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLTI , size(p%FreqList), 'SPLTI' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%SPLTIGui , size(p%FreqList), 'SPLTIGui' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%CfVar , 2 , 'CfVar' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%d99Var , 2 , 'd99Var' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%dstarVar , 2 , 'dstarVar' , errStat2, errMsg2); if(Failed()) return + call AllocAry(m%EdgeVelVar , 2 , 'EdgeVelVar', errStat2, errMsg2); if(Failed()) return + call AllocAry(m%LE_Location, 3, p%NumBlNds, p%numBlades, 'LE_Location', ErrStat2, ErrMsg2); if(Failed()) return + m%ChordAngleLE = 0.0_ReKi + m%SpanAngleLE = 0.0_ReKi + m%ChordAngleTE = 0.0_ReKi + m%SpanAngleTE = 0.0_ReKi + m%rTEtoObserve = 0.0_ReKi + m%rLEtoObserve = 0.0_ReKi + m%SPLLBL = 0.0_ReKi + m%SPLP = 0.0_ReKi + m%SPLS = 0.0_ReKi + m%SPLALPH = 0.0_ReKi + m%SPLTBL = 0.0_ReKi + m%SPLBLUNT = 0.0_ReKi + m%SPLTIP = 0.0_ReKi + m%SPLTI = 0.0_ReKi + m%SPLTIGui = 0.0_ReKi + m%CfVar = 0.0_ReKi + m%d99Var = 0.0_ReKi + m%dstarVar = 0.0_ReKi + m%EdgeVelVar = 0.0_ReKi + m%LE_Location = 0.0_ReKi + m%speccou = 0 + m%filesopen = 0 +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine Init_MiscVars +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes (allocates) the misc variables for use during the simulation. +subroutine Init_states(xd, p, errStat, errMsg) + type(AA_DiscreteStateType), intent(inout) :: xd ! + type(AA_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: k,ji + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_DiscrStates' + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + + call AllocAry(xd%MeanVrel, p%NumBlNds, p%numBlades, 'xd%MeanVrel' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%VrelSq, p%NumBlNds, p%numBlades, 'xd%VrelSq' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%TIVrel, p%NumBlNds, p%numBlades, 'xd%TIVrel' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%MeanVxVyVz, p%NumBlNds, p%numBlades, 'xd%MeanVxVyVz', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%TIVx, p%NumBlNds, p%numBlades, 'xd%TIVx' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%VxSq, p%NumBlNds, p%numBlades, 'xd%VxSq' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%VrelStore, p%total_sample+1, p%NumBlNds, p%numBlades,'xd%VrelStore', ErrStat2, ErrMsg2) ! plus one just in case + if(Failed()) return + DO ji=1,size(xd%MeanVrel,2) + DO k=1,size(xd%MeanVrel,1) + xd%VrelSq (k,ji) = 0.0_ReKi ! Relative Velocity Squared for TI calculation (on the fly) + xd%MeanVrel (k,ji) = 0.0_ReKi ! Relative Velocity Mean calculation (on the fly) + xd%TIVrel(k,ji) = 0.0_ReKi ! Turbulence Intensity (for on the fly calculation) + xd%MeanVxVyVz (k,ji) = 0.0_ReKi ! + xd%TIVx (k,ji) = 0.0_ReKi ! + xd%VxSq (k,ji) = 0.0_ReKi ! + xd%VrelStore (1:size(xd%VrelStore,1),k,ji) = 0.0_ReKi ! + ENDDO + ENDDO + call AllocAry(xd%RegVxStor,p%total_sampleTI,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%Vxst',ErrStat2,ErrMsg2) + if(Failed()) return + call AllocAry(xd%allregcounter ,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%allregcounter',ErrStat2,ErrMsg2 ) + if(Failed()) return + call AllocAry(xd%VxSqRegion ,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%VxSqRegion' , ErrStat2, ErrMsg2) + if(Failed()) return + call AllocAry(xd%RegionTIDelete,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%RegionTIDelete', ErrStat2, ErrMsg2) + do ji=1,size(xd%allregcounter,2) + do k=1,size(xd%allregcounter,1) + xd%allregcounter(k,ji) = 2.0_Reki ! + xd%VxSqRegion(k,ji) = 0.0_ReKi ! + xd%RegionTIDelete(k,ji) = 0.0_ReKi ! + xd%RegVxStor(1:size(xd%RegVxStor,1),k,ji)=0.0_reki + enddo + enddo +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine Init_states +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... + type(AA_InputType), intent(in ) :: u !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters + type(AA_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! local variables + 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 ! 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 + ErrMsg = "" + ! Cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step + TEMPSTD = sqrt( u%Inflow(1,:,:)**2+u%Inflow(2,:,:)**2+u%Inflow(3,:,:)**2 ) + xd%MeanVxVyVz = (TEMPSTD + xd%MeanVxVyVz*n) / (n+1) + ! xd%VxSq = TEMPSTD**2 + xd%VxSq + ! TEMPSTD = sqrt( (xd%VxSq/(n+1)) - (xd%MeanVxVyVz**2) ) + ! xd%TIVx = (TEMPSTD / xd%MeanVxVyVz ) ! check inflow noise input for multiplication with 100 or not + + m%speccou= m%speccou+1 + IF( (p%TICalcMeth.eq.2) ) THEN + do i=1,p%NumBlades + do j=1,p%NumBlNds + abs_le_x=m%LE_Location(3,j,i)-p%hubheight + IF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN + angletemp=180+ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D + ELSEIF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN + angletemp=180-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D + ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN + angletemp=360-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D + ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN + angletemp=ATAN( m%LE_Location(2,j,i)/abs_le_x ) * R2D_D + ELSE + print*, 'problem in angletemp Aeroacoustics module' + ENDIF + !abs_le_x=ABS(abs_le_x) + do k=1,size(p%rotorregionlimitsrad) + IF (p%BlSpn(j,i)-p%rotorregionlimitsrad(k).lt.0) THEN ! it means location is in the k-1 region + !print*, abs_le_x,p%rotorregionlimitsrad(k),k-1 + GOTO 4758 + ENDIF + enddo + 4758 do rco=1,size(p%rotorregionlimitsalph) + IF (angletemp-p%rotorregionlimitsalph(rco).lt.0) THEN ! it means location is in the k-1 region + GOTO 9815 + ENDIF + enddo + 9815 xd%allregcounter(k-1,rco-1)=CEILING(xd%allregcounter(k-1,rco-1)+1.0_Reki) ! increase the sample amount in that specific 5 meter height vertical region + tempsingle = sqrt( u%Inflow(1,j,i)**2+u%Inflow(2,j,i)**2+u%Inflow(3,j,i)**2 ) ! + ! with storage region dependent moving average and TI + IF (INT(xd%allregcounter(k-1,rco-1)) .lt. (size(xd%RegVxStor,1)+1)) THEN + xd%RegVxStor(INT(xd%allregcounter(k-1,rco-1)),k-1,rco-1)=tempsingle + xd%TIVx(j,i) = 0 + xd%RegionTIDelete(k-1,rco-1)=0 + ELSE + xd%RegVxStor((mod(INT(xd%allregcounter(k-1,rco-1))-size(xd%RegVxStor,1),size(xd%RegVxStor,1)))+1,k-1,rco-1)=tempsingle + tempmean=SUM(xd%RegVxStor(:,k-1,rco-1)) + tempmean=tempmean/size(xd%RegVxStor,1) + xd%RegionTIDelete(k-1,rco-1)=SQRT((SUM((xd%RegVxStor(:,k-1,rco-1)-tempmean)**2)) / size(xd%RegVxStor,1) ) + xd%TIVx(j,i) = xd%RegionTIDelete(k-1,rco-1) ! only the fluctuation + ENDIF + enddo + enddo + + ELSE! interpolate from the user given ti values + do i=1,p%NumBlades + do j=1,p%NumBlNds + zi_a=ABS(m%LE_Location(3,j,i) - (FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))) ) /p%dz_turb_in + z0_a=floor(zi_a) + z1_a=ceiling(zi_a) + zd_a=zi_a-z0_a + yi_a=ABS(m%LE_Location(2,j,i) + maxval(p%BlSpn(:,1)) ) /p%dy_turb_in + y0_a=floor(yi_a) + y1_a=ceiling(yi_a) + yd_a=yi_a-y0_a + c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) + c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) + ! 2 points + xd%TIVx(j,i)=(1.0_ReKi-zd_a)*c00_a+zd_a*c10_a + if (i.eq.p%NumBlades) then + if (j.eq.p%NumBlNds) then + endif + endif + enddo + enddo + endif +end subroutine AA_UpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine AA_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + TYPE(AA_InputType), INTENT(INOUT) :: u !< System inputs + TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(AA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + TYPE(AA_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states + TYPE(AA_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(AA_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! Destroy the input data: + CALL AA_DestroyInput( u, ErrStat, ErrMsg ) + ! Destroy the parameter data: + CALL AA_DestroyParam( p, ErrStat, ErrMsg ) + ! Destroy the state data: + CALL AA_DestroyContState( x, ErrStat, ErrMsg ) + CALL AA_DestroyDiscState( xd, ErrStat, ErrMsg ) + CALL AA_DestroyConstrState( z, ErrStat, ErrMsg ) + CALL AA_DestroyOtherState( OtherState, ErrStat, ErrMsg ) + CALL AA_DestroyMisc( m, ErrStat, ErrMsg ) + ! Destroy the output data: + CALL AA_DestroyOutput( y, ErrStat, ErrMsg ) + +END SUBROUTINE AA_End + +!> Routine for computing outputs, used in both loose and tight coupling. +!! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. +!! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for +!! for a complete description of each output parameter. +subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) + ! NOTE: no matter how many channels are selected for output, all of the outputs are calcalated + ! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are + ! placed in the y%WriteOutput(:) array. + !.................................................................................................................................. + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AA_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(AA_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(AA_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(AA_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + type(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer, parameter :: indx = 1 ! 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' + ErrStat = ErrID_None + ErrMsg = "" + ! assume integer divide is possible + call CalcObserve(t,p,m,u,xd,errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (t >= p%AAStart) THEN + IF (mod(t + 1E-10,p%DT) .lt. 1E-6) THEN + call CalcAeroAcousticsOutput(u,p,m,xd,y,errStat2,errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call Calc_WriteOutput( p, u, m, y, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AA_WriteOutputLine(y, t, p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ENDIF + ENDIF +end subroutine AA_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!----------------------------------------------------------------------------------------------------------------------------------! +SUBROUTINE CalcObserve(t,p,m,u,xd,errStat,errMsg) + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< discrete state type + TYPE(AA_ParameterType), intent(in ) :: p !< Parameters + TYPE(AA_InputType), intent(in ) :: u !< NN Inputs at Time + TYPE(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) + INTEGER(IntKi), intent( out) :: errStat !< Error status of the operation + CHARACTER(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables. + REAL(ReKi) :: RLEObserve (3) ! Position vector from leading edge to observer in trailing edge coordinate system + REAL(ReKi) :: RTEObserve (3) ! Position vector from trailing edge to observer in trailing edge coordinate system + REAL(ReKi) :: RTEObserveG (3) ! Position vector from trailing edge to observer in the coordinate system located at the trailing edge and rotated as the global + REAL(ReKi) :: RLEObserveG (3) ! Position vector from leading edge to observer in the coordinate system located at the leading edge and rotated as the global + REAL(ReKi) :: RTEObservereal (3) ! Location of trailing edge in global coordinate system + REAL(ReKi) :: RLEObservereal (3) ! Location of leading edge in global coordinate system + REAL(ReKi) :: LocalToGlobal(3,3) ! Transformation matrix + REAL(ReKi) :: timeLE ! Time of sound propagation from leading edge to observer + REAL(ReKi) :: timeTE ! Time of sound propagation from trailing edge to observer + REAL(ReKi) :: phi_e ! Spanwise directivity angle + REAL(ReKi) :: theta_e ! Chordwise directivity angle + INTEGER(intKi) :: I ! I A generic index for DO loops. + 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 + CHARACTER(*), parameter :: RoutineName = 'CalcObserveDist' + LOGICAL :: exist + + ErrStat = ErrID_None + ErrMsg = "" + ! Loop through the blades + DO I = 1,p%numBlades + ! Loop through the nodes along blade span + DO J = 1,p%NumBlNds + ! Transpose the rotational vector GlobalToLocal to obtain the rotation LocalToGlobal + LocalToGlobal = TRANSPOSE(u%RotGtoL(:,:,J,I)) + ! Rotate the coordinates of leading and trailing edge from the local reference system to the global. Then add the coordinates of the aerodynamic center in the global coordinate system + ! The global coordinate system is located on the ground, has x pointing downwind, y pointing laterally, and z pointing vertically upwards + RTEObservereal = MATMUL(LocalToGlobal, p%AFTeCo(:,J,I)) + u%AeroCent_G(:,J,I) + RLEObservereal = MATMUL(LocalToGlobal, p%AFLeCo(:,J,I)) + u%AeroCent_G(:,J,I) + ! Compute the coordinates of the leading edge in the global coordinate system + m%LE_Location(1,J,I) = RLEObservereal(1) + m%LE_Location(2,J,I) = RLEObservereal(2) + m%LE_Location(3,J,I) = RLEObservereal(3) + ! If the time step is set to generate AA outputs + IF (t >= p%AAStart) THEN + IF ( mod(t + 1E-10,p%DT) .lt. 1E-6) THEN + ! Loop through the observers + DO K = 1,p%NrObsLoc + ! Calculate the position of the observer K in a reference system located at the trailing edge and oriented as the global reference system + RTEObserveG(1)=p%Obsx(K)-RTEObservereal(1) + RTEObserveG(2)=p%Obsy(K)-RTEObservereal(2) + RTEObserveG(3)=p%Obsz(K)-RTEObservereal(3) + ! Calculate the position of the observer K in a reference system located at the leading edge and oriented as the global reference system + RLEObserveG(1)=p%Obsx(K)-RLEObservereal(1) + RLEObserveG(2)=p%Obsy(K)-RLEObservereal(2) + RLEObserveG(3)=p%Obsz(K)-RLEObservereal(3) + ! Rotate back the two reference systems from global to local. + RTEObserve = MATMUL(u%RotGtoL(:,:,J,I), RTEObserveG) + RLEObserve = MATMUL(u%RotGtoL(:,:,J,I), RLEObserveG) + + ! Calculate absolute distance between node and observer + m%rTEtoObserve(K,J,I) = SQRT (RTEObserve(1)**2+RTEObserve(2)**2+RTEObserve(3)**2) + m%rLEtoObserve(K,J,I) = SQRT (RLEObserve(1)**2+RLEObserve(2)**2+RLEObserve(3)**2) + + ! Calculate time of noise propagation to observer + timeTE = m%rTEtoObserve(K,J,I) / p%SpdSound + timeLE = m%rLEtoObserve(K,J,I) / p%SpdSound + + ! The local system has y alinged with the chord, x pointing towards the airfoil suction side, and z aligned with blade span from root towards tip + ! x ---> z_e + ! y ---> x_e + ! z ---> y_e + + ! Compute spanwise directivity angle phi for the trailing edge + phi_e = ATAN2 (RTEObserve(1) , RTEObserve(3)) + m%SpanAngleTE(K,J,I) = phi_e * R2D + + ! Compute chordwise directivity angle theta for the trailing edge + theta_e = ATAN2 ((RTEObserve(3) * COS (phi_e) + RTEObserve(1) * SIN (phi_e) ) , RTEObserve(2)) + m%ChordAngleTE(K,J,I) = theta_e * R2D + + ! Compute spanwise directivity angle phi for the leading edge (it's the same angle for the trailing edge) + phi_e = ATAN2 (RLEObserve(1) , RLEObserve(3)) + m%SpanAngleLE(K,J,I) = phi_e * R2D + + ! Compute chordwise directivity angle theta for the leading edge + theta_e = ATAN2 ((RLEObserve(3) * COS (phi_e) + RLEObserve(1) * SIN (phi_e) ) , RLEObserve(2)) + m%ChordAngleLE(K,J,I) = theta_e * R2D + + ENDDO !K, observers + ENDIF ! every Xth time step or so.. + ENDIF ! only if the time step is more than user input value run this part + ENDDO !J, blade nodes + ENDDO !I , number of blades +END SUBROUTINE CalcObserve +!----------------------------------------------------------------------------------------------------------------------------------! +SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) + TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(AA_OutputType), INTENT(INOUT) :: y !< + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) + TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< discrete state type + integer(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables. + integer(intKi) :: III !III A generic index for DO loops. + integer(intKi) :: I !I A generic index for DO loops. + integer(intKi) :: J !J A generic index for DO loops. + integer(intKi) :: K,liop,cou ,JTEMP !K A generic index for DO loops. + integer(intKi) :: oi !K A generic index for DO loops. + REAL(ReKi) :: AlphaNoise ! + REAL(ReKi) :: UNoise ! + REAL(ReKi) :: elementspan ! + REAL(ReKi),DIMENSION(p%NumBlNds) ::tempdel + REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) ::OASPLTBLAll + REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades,size(p%FreqList)) ::ForMaxLoc + REAL(ReKi),DIMENSION(size(y%OASPL_Mech,1),size(p%FreqList),p%NrObsLoc,p%NumBlNds,p%numBlades) :: ForMaxLoc3 + REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) ::SPL_Out + REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthick + REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthickchord + + real(ReKi) :: Ptotal + real(ReKi) :: PtotalLBL + real(ReKi) :: PtotalTBLP + real(ReKi) :: PtotalTBLS + real(ReKi) :: PtotalSep + real(ReKi) :: PtotalTBLAll + real(ReKi) :: PtotalBlunt + real(ReKi) :: PtotalTip + real(ReKi) :: PtotalInflow + real(ReKi) :: PLBL + real(ReKi) :: PTBLP + real(ReKi) :: PTBLS + real(ReKi) :: PTBLALH + real(ReKi) :: PTip + real(ReKi) :: PTI + real(ReKi) :: PBLNT,adforma + REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star + TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using + REAL(ReKi),DIMENSION(p%total_sample) :: spect_signal + REAL(ReKi),DIMENSION(p%total_sample/2) :: spectra + real(ReKi),ALLOCATABLE :: fft_freq(:) + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' + logical :: exist + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------- Fill with zeros -------------------------! + DO I = 1,p%numBlades;DO J = 1,p%NumBlNds;DO K = 1,p%NrObsLoc; + y%OASPL(k,j,i) = 0.0_Reki + DO oi=1,size(y%OASPL_Mech,1) + y%OASPL_Mech(oi,k,j,i)= 0.0_Reki + ENDDO; + ENDDO;ENDDO;ENDDO + + DO K = 1,p%NrObsLoc; + y%DirectiviOutput(K) = 0.0_Reki + DO I=1,p%NumBlades;DO III=1,size(p%FreqList); + y%SumSpecNoise(III,K,I) = 0.0_Reki + ForMaxLoc(K,1:p%NumBlNds,I,III)=0.0_Reki + DO oi=1,size(y%OASPL_Mech,1) + y%SumSpecNoiseSep(oi,K,III) = 0.0_Reki + ForMaxLoc3(oi,III,K,1:p%NumBlNds,I)=0.0_Reki + m%SPLLBL(III)=0.0_Reki + m%SPLP(III)=0.0_Reki + m%SPLS(III)=0.0_Reki + m%SPLALPH(III)=0.0_Reki + m%SPLBLUNT(III)=0.0_Reki + m%SPLTIP(III)=0.0_Reki + m%SPLti(III)=0.0_Reki + ENDDO + ENDDO;ENDDO + ENDDO + + DO K = 1,p%NrObsLoc; + DO III = 1,size(p%FreqList); + y%PtotalFreq(K,III) = 0.0_ReKi + ENDDO + ENDDO + + !------------------- initialize FFT -------------------------! + !!!IF (m%speccou .eq. p%total_sample)THEN + !!!CALL InitFFT ( p%total_sample, FFT_Data, ErrStat=ErrStat2 ) + !!! CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) + !!!CALL AllocAry( fft_freq, size(spect_signal)/2-1, 'fft_freq', ErrStat2, ErrMsg2 ) + !!! CALL SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + !!!do liop=1,size(fft_freq) + !!! fft_freq(liop)=p%fsample*liop ! fRequncy x axis + !!! fft_freq(liop)=fft_freq(liop)/size(spect_signal) + !!!enddo + !!!ENDIF + + + + DO I = 1,p%numBlades + DO J = p%startnode,p%NumBlNds ! starts loop from startnode. + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + !--------Calculate Spectrum for dissipation calculation-------------------------! + !IF (m%speccou .eq. p%total_sample)THEN + !spect_signal=xd%VrelStore( 1:p%total_sample,J,I ) + ! CALL ApplyFFT_f( spect_signal, FFT_Data, ErrStat2 ) + ! IF (ErrStat2 /= ErrID_None ) THEN + ! CALL SetErrStat(ErrStat2, 'Error in ApplyFFT .', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) + ! ENDIF + !cou=1 + !O liop=2,size(spect_signal)-1,2 + !cou=cou+1 + !spectra(cou) = spect_signal(liop)*spect_signal(liop) + spect_signal(1+liop)*spect_signal(1+liop) + !ENDDO + !spectra(1)=spect_signal(1)*spect_signal(1) + !spectra=spectra/(size(spectra)*2) + ! m%speccou=0 + !ENDIF + + Unoise = u%Vrel(J,I) + IF (EqualRealNos(Unoise,0.0_ReKi)) then + Unoise = 0.1 ! TODO TODO a value consistent with the test above should be used + ENDIF + IF (J .EQ. p%NumBlNds) THEN + elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + ELSE + elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + (p%BlSpn(J+1,I)-p%BlSpn(J,I))/2 + ENDIF + AlphaNoise= u%AoANoise(J,I) * R2D_D + + + !--------Read in Boundary Layer Data-------------------------! + IF (p%X_BLMethod .EQ. 2) THEN + call BL_Param_Interp(p,m,Unoise,AlphaNoise,p%BlChord(J,I),p%BlAFID(J,I), errStat2, errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + temp_dispthick(J,I) = m%d99Var(1) + m%d99Var = m%d99Var*p%BlChord(J,I) + m%dstarVar = m%dstarVar*p%BlChord(J,I) + temp_dispthickchord(J,I)=m%d99Var(1) + ENDIF + + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + DO K = 1,p%NrObsLoc + !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! + IF ( (p%ILAM .EQ. 1) .AND. (p%ITRIP .EQ. 0) ) THEN + CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + elementspan,m%rTEtoObserve(K,J,I), & + p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,p%StallStart(J,I),errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! + IF ( (p%ITURB .EQ. 1) .or. (p%ITURB .EQ. 2) ) THEN + CALL TBLTE(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + elementspan,m%rTEtoObserve(K,J,I), p, j,i,k,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), & + elementspan,m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & + m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + ENDIF + !--------Blunt Trailing Edge Noise----------------------------------------------! + IF ( p%IBLUNT .EQ. 1 ) THEN + CALL BLUNT(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + elementspan,m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & + p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,p%StallStart(J,I),errStat2,errMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + !--------Tip Noise--------------------------------------------------------------! + IF ( (p%ITIP .EQ. 1) .AND. (J .EQ. p%NumBlNds) ) THEN + CALL TIPNOIS(AlphaNoise,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + m%rTEtoObserve(K,J,I), p, m%SPLTIP,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + !--------Inflow Turbulence Noise ------------------------------------------------! + ! important checks to be done inflow tubulence inputs + IF (p%IInflow.gt.0) then + + ! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On + CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& + elementspan,m%rLEtoObserve(K,J,I),xd%MeanVxVyVz(J,I),xd%TIVx(J,I),m%LE_Location(3,J,I),0.050,p,m%SPLti,errStat2,errMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added + IF ( p%IInflow .EQ. 2 ) THEN + CALL Simple_Guidati(UNoise,p%BlChord(J,I),p%AFThickGuida(2,p%BlAFID(J,I)), & + p%AFThickGuida(1,p%BlAFID(J,I)),p,m%SPLTIGui,errStat2,errMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + m%SPLti=m%SPLti+m%SPLTIGui + 10. ! +10 is fudge factor to match NLR data + ELSEIF ( p%IInflow .EQ. 3 ) THEN + print*,'Full Guidati removed' + STOP + ENDIF + ENDIF + !----------------------------------------------------------------------------------------------------------------------------------! + ! ADD IN THIS SEGMENT'S CONTRIBUTION ON A MEAN-SQUARE + ! PRESSURE BASIS + !----------------------------------------------------------------------------------------------------------------------------------! + Ptotal = 0.0_ReKi ! Total Sound Pressure - All (7) mechanisms, All Frequencies + PtotalLBL= 0.0_ReKi ! Total Sound Pressure - Laminar Boundary Layer, All Frequencies + PtotalTBLP= 0.0_ReKi ! Total Sound Pressure - Turbulent Boundary Layer, Pressure Contribution, All Frequencies + PtotalTBLS= 0.0_ReKi ! Total Sound Pressure - Turbulent Boundary Layer, Suction Contribution, All Frequencies + PtotalSep= 0.0_ReKi ! Total Sound Pressure - Separation, All Frequencies + PtotalTBLAll = 0.0_ReKi ! Total Sound Pressure - Turbulent Boundary Layer, All Frequencies + PtotalBlunt= 0.0_ReKi ! Total Sound Pressure - Blunt Trailing Edge, All Frequencies + PtotalTip= 0.0_ReKi ! Total Sound Pressure - Tip Noise, All Frequencies + PtotalInflow= 0.0_ReKi ! Total Sound Pressure - Turbulent Inflow, All Frequencies + PLBL= 0.0_ReKi ! Laminar Boundary Layer - Current Iteration + PTBLP= 0.0_ReKi ! Turbulent Boundary Layer, Pressure Contribution - Current Iteration + PTBLS= 0.0_ReKi ! Turbulent Boundary Layer, Suction Contribution - Current Iteration + PTBLALH= 0.0_ReKi ! Turbulent Boundary Layer, Angle of Attack Contribution - Current Iteration (Feeds into PTotalSep. Consider renaming.) + PTip= 0.0_ReKi ! Tip Noise - Current Iteration + PTI= 0.0_ReKi ! Turbulent Inflow - Current Iteration + PBLNT= 0.0_ReKi ! Blunt Trailing Edge - Current Iteration + + + DO III=1,size(p%FreqList) ! Loops through each 1/3rd octave center frequency + + ! If flag for LBL is ON and Boundary Layer Trip is OFF, then compute LBL + IF ( (p%ILAM .EQ. 1) .AND. (p%ITRIP .EQ. 0) ) THEN + IF (p%AweightFlag .eqv. .TRUE.) THEN + m%SPLLBL(III) = m%SPLLBL(III) + p%Aweight(III) ! A-weighting + ENDIF + + PLBL = 10.0_ReKi**(m%SPLLBL(III)/10.0_ReKi) ! SPL to Sound Pressure (P) Conversion for III Frequency + + PtotalLBL = PtotalLBL + PLBL ! Sum of Current LBL with LBL Running Total + Ptotal = Ptotal + PLBL ! Sum of Current LBL with Overall Running Total + y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PLBL ! Running sum of observer and frequency dependent sound pressure + + y%SumSpecNoiseSep(1,K,III) = PLBL + y%SumSpecNoiseSep(1,K,III) ! Assigns Current LBL to Appropriate Mechanism (1), Observer (K), and Frequency (III) + ENDIF + + ! If flag for TBL is ON, compute Pressure, Suction, and AoA contributions + IF ( p%ITURB .GT. 0 ) THEN + IF (p%AweightFlag .eqv. .TRUE.) THEN + m%SPLP(III) = m%SPLP(III) + p%Aweight(III) ! A-weighting + m%SPLS(III) = m%SPLS(III) + p%Aweight(III) ! A-weighting + m%SPLALPH(III) = m%SPLALPH(III) + p%Aweight(III) ! A-weighting + ENDIF + + PTBLP = 10.0_ReKi**(m%SPLP(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + PTBLS = 10.0_ReKi**(m%SPLS(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + PTBLALH = 10.0_ReKi**(m%SPLALPH(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + + PtotalTBLP = PtotalTBLP + PTBLP ! Sum of Current TBLP with TBLP Running Total + PtotalTBLS = PtotalTBLS + PTBLS ! Sum of Current TBLS with TBLS Running Total + PtotalSep = PtotalSep + PTBLALH ! Sum of Current TBLALH with TBLALH Running Total + + Ptotal = Ptotal + PTBLP + PTBLS + PTBLALH ! Sum of Current TBL with Overall Running Total + y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PTBLP + PTBLS + PTBLALH ! Running sum of observer and frequency dependent sound pressure + PtotalTBLAll = PtotalTBLAll + 10.0_ReKi**(m%SPLTBL(III)/10.0_ReKi) ! SPLTBL from comment on line 1794 is the mean-square sum of SPLP, SPLS, and SPLALPH. + ! So this should be equal to PTBLP+PTBLS+TBLALH + y%SumSpecNoiseSep(2,K,III) = PTBLP + y%SumSpecNoiseSep(2,K,III) ! Assigns Current TBLP to Appropriate Mechanism (2), Observer (K), and Frequency (III) + y%SumSpecNoiseSep(3,K,III) = PTBLS + y%SumSpecNoiseSep(3,K,III) ! Assigns Current TBLS to Appropriate Mechanism (2), Observer (K), and Frequency (III) + y%SumSpecNoiseSep(4,K,III) = PTBLALH + y%SumSpecNoiseSep(4,K,III) ! Assigns Current TBLALH to Appropriate Mechanism (2), Observer (K), and Frequency (III) + ENDIF + + ! If flag for Blunt TE is ON, compute Blunt contribution + IF ( p%IBLUNT .GT. 0 ) THEN ! NOTE: .EQ. 1 would be more accurate since only options are 0 and 1 + IF (p%AweightFlag .eqv. .TRUE.) THEN + m%SPLBLUNT(III) = m%SPLBLUNT(III) + p%Aweight(III) ! A-weighting + ENDIF + + PBLNT = 10.0_ReKi**(m%SPLBLUNT(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + + PtotalBlunt = PtotalBlunt + PBLNT ! Sum of Current Blunt with Blunt Running Total + Ptotal = Ptotal + PBLNT ! Sum of Current Blunt with Overall Running Total + y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PBLNT ! Running sum of observer and frequency dependent sound pressure + + y%SumSpecNoiseSep(5,K,III) = PBLNT + y%SumSpecNoiseSep(5,K,III) ! Assigns Current Blunt to Appropriate Mechanism (5), Observer (K), and Frequency (III) + ENDIF + + ! If flag for Tip is ON and the current blade node (J) is the last node (tip), compute Tip contribution + IF ( (p%ITIP .GT. 0) .AND. (J .EQ. p%NumBlNds) ) THEN ! NOTE: .EQ. 1 would again be more accurate + IF (p%AweightFlag .eqv. .TRUE.) THEN + m%SPLTIP(III) = m%SPLTIP(III) + p%Aweight(III) ! A-weighting + ENDIF + + PTip = 10.0_ReKi**(m%SPLTIP(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + + PtotalTip = PtotalTip + PTip ! Sum of Current Tip with Tip Running Total + Ptotal = Ptotal + PTip ! Sum of Current Tip with Overall Running Total + y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PTip ! Running sum of observer and frequency dependent sound pressure + + y%SumSpecNoiseSep(6,K,III) = PTip + y%SumSpecNoiseSep(6,K,III) ! Assigns Current Tip to Appropriate Mechanism (6), Observer (K), and Frequency (III) + ENDIF + + ! If flag for TI is ON, compute Turbulent Inflow contribution + IF ( (p%IInflow .GT. 0) ) THEN + IF (p%AweightFlag .eqv. .TRUE.) THEN + m%SPLti(III) = m%SPLti(III) + p%Aweight(III) ! A-weighting + ENDIF + + PTI = 10.0_ReKi**(m%SPLti(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + + PtotalInflow = PtotalInflow + PTI ! Sum of Current TI with TI Running Total + Ptotal = Ptotal + PTI ! Sum of Current TI with Overall Running Total + y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PTI ! Running sum of observer and frequency dependent sound pressure + + y%SumSpecNoiseSep(7,K,III) = PTI + y%SumSpecNoiseSep(7,K,III) ! Assigns Current TI to Appropriate Mechanism (7), Observer (K), and Frequency (III) + ENDIF + + ENDDO ! III = 1, size(p%FreqList) + + y%DirectiviOutput(K) = Ptotal + y%DirectiviOutput(K) ! Assigns Overall Pressure to Appropriate Observer for Directivity + IF (y%DirectiviOutput(K) .EQ. 0.) y%DirectiviOutput(K) = 1 ! Since these will all be converted via LOG10, they will produce an error if .EQ. 0. + ! Set .EQ. to 1 instead (LOG10(1)=0) + y%OASPL(K,J,I) = Ptotal + y%OASPL(K,J,I) ! Assigns Overall Pressure to Appropriate Observer/Blade/Node for Directivity + ENDDO ! Loop on observers + ENDDO ! Loop on blade nodes + ENDDO ! Loop on blades + + ! If any Output file is wanted, convert DirectiviOutput from Directivity Factor to Directivity Index + ! Ref: Fundamentals of Acoustics by Colin Hansen (1951) + y%DirectiviOutput = 10.*LOG10(y%DirectiviOutput) !! DirectiviOutput is used as total observer OASPL for Output File 1 + ! Since these will all be converted via LOG10, they will produce an error if .EQ. 0., Set .EQ. to 1 instead (LOG10(1)=0) + DO I = 1,p%numBlades + DO J = 1,p%NumBlNds + DO K = 1,p%NrObsLoc + IF (y%OASPL(K,J,I) .EQ. 0.) y%OASPL(K,J,I) = 1 + ENDDO + ENDDO + ENDDO + IF (p%NrOutFile .gt. 0) y%OASPL = 10.*LOG10(y%OASPL) !! OASPL is used as observer/blade/node OASPL for Output File 4 + + ! Procedure for Output file 2 + IF (p%NrOutFile .gt. 1) THEN + DO K = 1,p%NrObsLoc + DO III=1,size(p%FreqList) + IF (y%PtotalFreq(K,III) .EQ. 0.) y%PtotalFreq(K,III) = 1 + y%PtotalFreq(K,III) = 10.*LOG10(y%PtotalFreq(K,III)) ! P to SPL conversion + ENDDO + ENDDO + ENDIF + + ! If 3rd Output file is needed, these will need to be converted via LOG10. Change to equal 1 to avoid error. + DO K = 1,p%NrObsLoc + DO III = 1,size(p%FreqList) + DO oi = 1,7 + IF (y%SumSpecNoiseSep(oi,K,III) .EQ. 0.) y%SumSpecNoiseSep(oi,K,III) = 1 + ENDDO + ENDDO + ENDDO + + ! Procedure for Output file 3 + IF (p%NrOutFile .gt. 2) THEN + y%SumSpecNoiseSep = 10.*LOG10(y%SumSpecNoiseSep) ! P to SPL Conversion + ENDIF + +END SUBROUTINE CalcAeroAcousticsOutput +!==================================================================================================================================! +SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM,StallVal,errStat,errMsg) + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA + REAL(ReKi), INTENT(IN ) :: C ! Chord Length + REAL(ReKi), INTENT(IN ) :: U ! Unoise FREESTREAM VELOCITY METERS/SEC + REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE DEGREES + REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE DEGREES + REAL(ReKi), INTENT(IN ) :: L ! SPAN METERS + REAL(ReKi), INTENT(IN ) :: R ! OBSERVER DISTANCE FROM SEGMENT METERS + REAL(ReKi), INTENT(IN ) :: d99Var2 ! + REAL(ReKi), INTENT(IN ) :: dstarVar1 ! + REAL(ReKi), INTENT(IN ) :: dstarVar2 ! + REAL(ReKi), INTENT(IN ) :: StallVal ! + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise module Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLLAM ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'LBLVS' + ! Local variables + real(ReKi) :: STPRIM ! STROUHAL NUMBER BASED ON PRESSURE SIDE BOUNDARY LAYER THICKNESS --- + real(ReKi) :: M ! MACH NUMBER + real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD + real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS + real(ReKi) :: DSTRS ! SUCTION SIDE BOUNDARY LAYER DISPLACEMENT THICKNESS METERS + real(ReKi) :: DSTRP ! PRESSURE SIDE BOUNDARY LAYER DISPLACEMENT THICKNESS METERS + real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- + real(ReKi) :: ST1PRIM ! REFERENCE STROUHAL NUMBER --- + real(ReKi) :: STPKPRM ! PEAK STROUHAL NUMBER --- + real(ReKi) :: RC0 ! REFERENCE REYNOLDS NUMBER --- + real(ReKi) :: D ! REYNOLDS NUMBER RATIO --- + real(ReKi) :: G1 ! SOUND PRESSURE LEVEL FUNCTION DB + real(ReKi) :: G2 ! OVERALL SOUND PRESSURE LEVEL FUNCTION DB + real(ReKi) :: G3 ! OVERALL SOUND PRESSURE LEVEL FUNCTION DB + real(ReKi) :: E ! STROUHAL NUMBER RATIO --- + real(ReKi) :: SCALE ! GEOMETRIC SCALING TERM + integer(intKi) :: I ! I A generic index for DO loops. + ErrStat = ErrID_None + ErrMsg = "" + !compute reynolds number and mach number + M = U / p%SpdSound ! MACH NUMBER + RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD + ! compute boundary layer thicknesses + IF (p%X_BLMethod .eq. 2) THEN + DELTAP = d99Var2 + DSTRS = dstarVar1 + DSTRP = dstarVar2 + ELSE + CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + ! compute directivity function + CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (DBARH <= 0) THEN + SPLLAM = 0. + RETURN + ENDIF + ! compute reference strouhal number ! Eq 55 from BPM Airfoil Self-noise and Prediction paper + IF (RC .LE. 1.3E+05) ST1PRIM = .18 + IF((RC .GT. 1.3E+05).AND.(RC.LE.4.0E+05))ST1PRIM=.001756*RC**.3931 + IF (RC .GT. 4.0E+05) ST1PRIM = .28 + STPKPRM = 10.**(-.04*ALPSTAR) * ST1PRIM ! Eq 56 from BPM Airfoil Self-noise and Prediction paper + + ! compute reference reynolds number ! Eq 59 from BPM Airfoil Self-noise and Prediction paper + IF (ALPSTAR .LE. 3.0) RC0=10.**(.215*ALPSTAR+4.978) + IF (ALPSTAR .GT. 3.0) RC0=10.**(.120*ALPSTAR+5.263) + ! compute peak scaled spectrum level + D = RC / RC0 ! Used in Eq 58 from BPM Airfoil Self-noise and Prediction paper + IF (D .LE. .3237) G2 =77.852*LOG10(D)+15.328 ! Begin Eq 58 from BPM Airfoil Self-noise and Prediction paper + IF ((D .GT. .3237).AND.(D .LE. .5689)) G2 = 65.188*LOG10(D) + 9.125 + IF ((D .GT. .5689).AND.(D .LE. 1.7579)) G2 = -114.052 * LOG10(D)**2. + IF ((D .GT. 1.7579).AND.(D .LE. 3.0889)) G2 = -65.188*LOG10(D)+9.125 + IF (D .GT. 3.0889) G2 =-77.852*LOG10(D)+15.328 ! end + ! compute angle-dependent level for shape curve + G3 = 171.04 - 3.03 * ALPSTAR ! Eq 60 from BPM Airfoil Self-noise and Prediction paper + SCALE = 10. * LOG10(DELTAP*M**5*DBARH*L/R**2) ! From Eq 53 from BPM Airfoil Self-noise and Prediction paper + ! Compute scaled sound pressure levels for each strouhal number + DO I=1,SIZE(p%FreqList) + STPRIM = p%FreqList(I) * DELTAP / U ! Eq 54 from BPM Airfoil Self-noise and Prediction paper + E = STPRIM / STPKPRM ! Used in Eq 57 from BPM Airfoil Self-noise and Prediction paper + IF (E .LE. .5974) G1 = 39.8*LOG10(E)-11.12 ! Begin Eq 57 from BPM Airfoil Self-noise and Prediction paper + IF ((E .GT. .5974).AND.(E .LE. .8545)) G1 = 98.409 * LOG10(E) + 2.0 + IF ((E .GT. .8545).AND.(E .LE. 1.17)) G1 = -5.076+SQRT(2.484-506.25*(LOG10(E))**2.) + IF ((E .GT. 1.17).AND.(E .LE. 1.674)) G1 = -98.409 * LOG10(E) + 2.0 + IF (E .GT. 1.674) G1 = -39.80*LOG10(E)-11.12 ! end + 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) + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA(deg) + REAL(ReKi), INTENT(IN ) :: C ! Chord Length (m) +! REAL(ReKi), INTENT(IN ) :: U ! Unoise(m/s) +! REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE (deg) +! REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: L ! SPAN(m) + REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE (m) + +! REAL(ReKi) :: ALPSTAR ! AOA(deg) +! REAL(ReKi) :: C ! Chord Length (m) + REAL(ReKi) :: U ! Unoise(m/s) + REAL(ReKi) :: THETA ! DIRECTIVITY ANGLE (deg) + REAL(ReKi) :: PHI ! DIRECTIVITY ANGLE (deg) +! REAL(ReKi) :: L ! SPAN(m) +! REAL(ReKi) :: R ! SOURCE TO OBSERVER DISTANCE (m) + + REAL(ReKi), INTENT(IN ) :: d99Var2 ! + 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) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL ! TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLALPH ! SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'TBLTE' + ! Local variables + real(ReKi) :: STP ! PRESSURE SIDE STROUHAL NUMBER --- + real(ReKi) :: STS ! SUCTION SIDE STROUHAL NUMBER --- + real(ReKi) :: DSTRS ! SUCTION SIDE DISPLACEMENT THICKNESS METERS + real(ReKi) :: DSTRP ! PRESSURE SIDE DISPLACEMENT THICKNESS METERS + real(ReKi) :: RDSTRS ! REYNOLDS NUMBER BASED ON SUCTION SIDE DISPLACEMENT THICKNESS + real(ReKi) :: RDSTRP ! REYNOLDS NUMBER BASED ON PRESSURE SIDE DISPLACEMENT THICKNESS + real(ReKi) :: ST1 ! PEAK STROUHAL NUMBER --- + real(ReKi) :: ST2 ! PEAK STROUHAL NUMBER --- + real(ReKi) :: ST1PRIM ! PEAK STROUHAL NUMBER --- + real(ReKi) :: A0 ! FUNCTION USED IN 'A' CALCULATION + real(ReKi) :: A02 ! FUNCTION USED IN 'A' CALCULATION + real(ReKi) :: ARA0 ! INTERPOLATION FACTOR + real(ReKi) :: ARA02 ! INTERPOLATION FACTOR + real(ReKi) :: B0 ! FUNCTION USED IN 'B' CALCULATION + real(ReKi) :: BMINB0 ! MINIMUM 'B' EVALUATED AT B0 DB + real(ReKi) :: BMINB ! MINIMUM 'B' EVALUATED AT B DB + real(ReKi) :: BMAXB0 ! MAXIMUM 'B' EVALUATED AT B0 DB + real(ReKi) :: BMAXB ! MAXIMUM 'B' EVALUATED AT B DB + real(ReKi) :: BRB0 ! INTERPOLATION FACTOR DB + real(ReKi) :: STPEAK ! PEAK STROUHAL NUMBER --- + real(ReKi) :: AMINA ! MINIMUM 'A' CURVE EVALUATED AT STROUHAL NUMBER RATIO DB + real(ReKi) :: AMINB ! MINIMUM 'A' CURVE EVALUATED AT B DB + real(ReKi) :: AMAXA ! MAXIMUM 'A' CURVE EVALUATED AT STROUHAL NUMBER RATIO (DB) + real(ReKi) :: AMAXB ! MAXIMUM 'A' CURVE EVALUATED AT B DB + real(ReKi) :: AMINA0 ! MAXIMUM 'B' EVALUATED AT B0 DB + real(ReKi) :: AMINA02 ! MINIMUM 'A' CURVE EVALUATED AT A02 DB + real(ReKi) :: AMAXA0 ! MAXIMUM 'A' CURVE EVALUATED AT A0 DB + real(ReKi) :: AMAXA02 ! MAXIMUM 'A' CURVE EVALUATED AT A02 DB + real(ReKi) :: A ! STROUHAL NUMBER RATIO --- + real(ReKi) :: B ! STROUHAL NUMBER RATIO --- + real(ReKi) :: AA ! 'A' SPECTRUM SHAPE EVALUATED AT STROUHAL NUMBER RATIO DB + real(ReKi) :: BB ! 'B' SPECTRUM SHAPE EVALUATED AT STROUHAL NUMBER RATIO DB + real(ReKi) :: DELK1 ! CORRECTION TO AMPLITUDE FUNCTION DB + real(ReKi) :: GAMMA ! USED IN 'B' COMPUTATION --- + real(ReKi) :: BETA ! USED IN 'B' COMPUTATION --- + real(ReKi) :: GAMMA0 ! USED IN 'B' COMPUTATION --- + real(ReKi) :: BETA0 ! USED IN 'B' COMPUTATION --- + real(ReKi) :: K1 ! AMPLITUDE FUNCTION (DB) + real(ReKi) :: K2 ! AMPLITUDE FUNCTION (DB) + real(ReKi) :: P1 ! PRESSURE SIDE PRESSURE (NT/M2) + real(ReKi) :: P2 ! SUCTION SIDE PRESSURE (NT/M2) + real(ReKi) :: P4 ! PRESSURE FROM ANGLE OF ATTACK CONTRIBUTION (NT/M2) + real(ReKi) :: M ! MACH NUMBER + real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD + real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS + real(ReKi) :: XCHECK ! USED TO CHECK FOR ANGLE OF ATTACK CONTRIBUTION + real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- + real(ReKi) :: DBARL ! LOW FREQUENCY DIRECTIVITY --- + + integer(intKi) :: I ! I A generic index for DO loops. + + LOGICAL :: SWITCH !!LOGICAL FOR COMPUTATION OF ANGLE OF ATTACK CONTRIBUTION + + + + ErrStat = ErrID_None + ErrMsg = "" + ! Compute reynolds number and mach number + M = U / p%SpdSound + RC = U * C/p%KinVisc + ! Compute boundary layer thicknesses + IF (p%X_BLMethod .eq. 2) THEN + DELTAP = d99Var2 + DSTRS = dstarVar1 + DSTRP = dstarVar2 + ELSE + CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + ! Compute directivity function + CALL DIRECTL(M,THETA,PHI,DBARL,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (DBARH <= 0) THEN + ! SPLP = 0. + ! SPLS = 0. + ! SPLALPH = 0. + ! RETURN + ! ENDIF + ! Calculate the reynolds numbers based on pressure and suction displacement thickness + RDSTRS = DSTRS * U / p%KinVisc + RDSTRP = DSTRP * U / p%KinVisc + ! Determine peak strouhal numbers to be used for 'a' and 'b' curve calculations + ST1 = .02 * M ** (-.6) ! Eq 32 from BPM Airfoil Self-noise and Prediction paper + ! Eq 34 from BPM Airfoil Self-noise and Prediction paper + IF (ALPSTAR .LE. 1.333) ST2 = ST1 + IF ((ALPSTAR .GT. 1.333).AND.(ALPSTAR .LE. StallVal)) ST2 = ST1*10.**(.0054*(ALPSTAR-1.333)**2.) + IF (ALPSTAR .GT. StallVal) ST2 = 4.72 * ST1 + ST1PRIM = (ST1+ST2)/2. ! Eq 33 from BPM Airfoil Self-noise and Prediction paper + CALL A0COMP(RC,A0) ! compute -20 dB dropout (returns A0) + CALL A0COMP(3.*RC,A02) ! compute -20 dB dropout for AoA > AoA_0 (returns A02) + ! Evaluate minimum and maximum 'a' curves at a0 + CALL AMIN(A0,AMINA0) + CALL AMAX(A0,AMAXA0) + CALL AMIN(A02,AMINA02) + CALL AMAX(A02,AMAXA02) + ! Compute 'a' max/min ratio ! Eq 39 from BPM Airfoil Self-noise and Prediction paper + ARA0 = (20. + AMINA0) / (AMINA0 - AMAXA0) + ARA02 = (20. + AMINA02)/ (AMINA02- AMAXA02) + ! Compute b0 to be used in 'b' curve calculations ! Eq 44 from BPM Airfoil Self-noise and Prediction paper + IF (RC .LT. 9.52E+04) B0 = .30 + IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & + B0 = (-4.48E-13)*(RC-8.57E+05)**2. + .56 + IF (RC .GE. 8.57E+05) B0 = .56 + ! Evaluate minimum and maximum 'b' curves at b0 + CALL BMIN(B0,BMINB0) + CALL BMAX(B0,BMAXB0) + ! Compute 'b' max/min ratio + BRB0 = (20. + BMINB0) / (BMINB0 - BMAXB0) + + ! For each center frequency, compute an 'a' prediction for the pressure side + STPEAK = ST1 + IF (RC .LT. 2.47E+05) K1 = -4.31 * LOG10(RC) + 156.3 ! Begin Eq 47 from BPM Airfoil Self-noise and Prediction paper + IF((RC .GE. 2.47E+05).AND.(RC .LE. 8.0E+05)) K1 = -9.0 * LOG10(RC) + 181.6 + IF (RC .GT. 8.0E+05) K1 = 128.5 ! end + IF (RDSTRP .LE. 5000.) DELK1 = -ALPSTAR*(5.29-1.43*LOG10(RDSTRP)) ! Begin Eq 48 from BPM Airfoil Self-noise and Prediction paper + IF (RDSTRP .GT. 5000.) DELK1 = 0.0 ! end + + GAMMA = 27.094 * M + 3.31 ! Begin Eq 49 from BPM Airfoil Self-noise and Prediction paper + BETA = 72.650 * M + 10.74 + GAMMA0 = 23.430 * M + 4.651 + BETA0 =-34.190 * M - 13.820 ! end + + IF (ALPSTAR .LE. (GAMMA0-GAMMA)) K2 = -1000.0 ! Begin Eq 49 from BPM Airfoil Self-noise and Prediction paper + IF ((ALPSTAR.GT.(GAMMA0-GAMMA)).AND.(ALPSTAR.LE.(GAMMA0+GAMMA))) & + K2=SQRT(BETA**2.-(BETA/GAMMA)**2.*(ALPSTAR-GAMMA0)**2.)+BETA0 + IF (ALPSTAR .GT. (GAMMA0+GAMMA)) K2 = -12.0 + K2 = K2 + K1 ! end + ! Check for 'a' computation for suction side + XCHECK = GAMMA0 + SWITCH = .FALSE. + !older version: + ! IF ((ALPSTAR .GE. XCHECK).OR.(ALPSTAR .GT. 12.5))SWITCH=.TRUE. + ! newer version + IF ((ALPSTAR .GE. XCHECK).OR.(ALPSTAR .GT. StallVal))SWITCH=.TRUE. + DO I=1,size(p%FreqList) + STP= p%FreqList(I) * DSTRP / U ! Eq 31 from BPM Airfoil Self-noise and Prediction paper + A = LOG10( STP / STPEAK ) ! Eq 37 from BPM Airfoil Self-noise and Prediction paper + CALL AMIN(A,AMINA) + CALL AMAX(A,AMAXA) + 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 + STS = p%FreqList(I) * DSTRS / U ! Eq 31 from BPM Airfoil Self-noise and Prediction paper + + IF (.NOT. SWITCH) THEN + A = LOG10( STS / ST1PRIM ) + CALL AMIN(A,AMINA) + CALL AMAX(A,AMAXA) + 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 + ! '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 + 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 + ! 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.) + ENDIF + ! Sum all contributions from 'a' and 'b' on both pressure and suction side on a mean-square pressure basis + IF (SPLP(I) .LT. -100.) SPLP(I) = -100. ! Similar to Eq 28 of BPM Airfoil Self-noise and Prediction paper + IF (SPLS(I) .LT. -100.) SPLS(I) = -100. ! Similar to Eq 29 of BPM Airfoil Self-noise and Prediction paper + IF (SPLALPH(I) .LT. -100.) SPLALPH(I) = -100. ! Eq 30 of BPM Airfoil Self-noise and Prediction paper recommends SPLALPH = 10log(stuff) + A' + K2, where A' is calculated same as A but with x3 Rc + + P1 = 10.**(SPLP(I) / 10.) ! SPL_Pressure + P2 = 10.**(SPLS(I) / 10.) ! SPL_Suction + P4 = 10.**(SPLALPH(I) / 10.) ! SPL_AoA + SPLTBL(I) = 10. * LOG10(P1 + P2 + P4) ! Eq 24 from BPM Airfoil Self-noise and Prediction paper + + + + ENDDO + +END SUBROUTINE TBLTE +!==================================================================================================================================! +SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) + REAL(ReKi), INTENT(IN ) :: ALPHTIP !< AOA + REAL(ReKi), INTENT(IN ) :: ALPRAT2 !< TIP LIFT CURVE SLOPE --- + REAL(ReKi), INTENT(IN ) :: C !< Chord Length + REAL(ReKi), INTENT(IN ) :: U !< FREESTREAM VELOCITY METERS/SEC + REAL(ReKi), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE DEGREES + REAL(ReKi), INTENT(IN ) :: PHI !< DIRECTIVITY ANGLE DEGREES + REAL(ReKi), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE METERS + TYPE(AA_ParameterType) , INTENT(IN ) :: p !< Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTIP !< + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'tipnoise' + REAL(ReKi) :: M ! MACH NUMBER --- + REAL(ReKi) :: MM ! MAXIMUM MACH NUMBER --- + REAL(ReKi) :: ALPTIPP ! CORRECTED TIP ANGLE OF ATTACK DEGREES + REAL(ReKi) :: DBARH ! DIRECTIVITY --- + REAL(ReKi) :: SCALE ! SCALING TERM --- + REAL(ReKi) :: STPP ! STROUHAL NUMBER --- + REAL(ReKi) :: UM ! MAXIMUM VELOCITY METERS/SEC + REAL(ReKi) :: L ! CHARACTERISTIC LENGTH FOR TIP METERS + REAL(ReKi) :: TERM ! SCALING TERM --- + integer(intKi) :: I !I A generic index for DO loops. + ErrStat = ErrID_None + ErrMsg = "" + IF (alphtip.eq.0.) THEN + SPLTIP= 0 + RETURN + ELSEIF (alphtip.lt.0.) THEN + ! alphtip = ABS (alphtip) ! (EB_DTU) NOT possible to change inten(in) variable, INSTEAD + ! ALPTIPP is equal to abs(alphtip) - see next equation + ENDIF + !! used to be ALPTIPP = ALPHTIP * ALPRAT2 + ALPTIPP = ABS(ALPHTIP) * ALPRAT2 + M = U / p%SpdSound ! MACH NUMBER + ! Compute directivity function + CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (p%ROUND) THEN + L = .008 * ALPTIPP * C ! Eq 63 from BPM Airfoil Self-noise and Prediction paper + ELSE + IF (ABS(ALPTIPP) .LE. 2.) THEN ! not sure where this comes from + L = (.023 + .0169*ALPTIPP) * C + ELSE + L = (.0378 + .0095*ALPTIPP) * C + ENDIF + 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 is correct according to Eq 61 from BPM Airfoil self-noise and Prediction paper + IF (TERM .NE. 0.0) THEN + SCALE = 10.*LOG10(TERM) + ELSE + SCALE = 0.0 + ENDIF + DO I=1,size(p%FreqList) + STPP = p%FreqList(I) * L / UM ! Eq 62 from BPM Airfoil Self-noise and Prediction paper + SPLTIP(I) = 126.-30.5*(LOG10(STPP)+.3)**2. + SCALE ! Eq 61 from BPM Airfoil Self-noise and Prediction paper + 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 +! REAL(ReKi), INTENT(IN ) :: MeanVNoise ! +! 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 ! + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'InflowNoise' +! local variables + REAL(ReKi) :: Beta2 ! Prandtl-Glauert correction factor + REAL(ReKi) :: DBARH ! High-frequency directivity correction factor + REAL(ReKi) :: DBARL ! Low-frequency directivity correction factor + REAL(ReKi) :: Directivity ! Directivity correction factor + REAL(ReKi) :: Frequency_cutoff ! Cutoff frequency between + REAL(ReKi) :: LFC ! low-frequency correction factor + REAL(ReKi) :: LTurb ! turbulence length scale (isotropic integral scale parameter from IEC standard (Von Karman)) + REAL(ReKi) :: Mach ! local mach number + REAL(ReKi) :: Sears ! Sears function + REAL(ReKi) :: SPLhigh ! predicted high frequency sound pressure level + REAL(ReKi) :: Ums ! mean square turbulence level + REAL(ReKi) :: WaveNumber ! wave number - non-dimensional frequency + REAL(ReKi) :: Kbar ! nafnoise + REAL(ReKi) :: khat,Kh ! nafnoise + REAL(ReKi) :: ke ! nafnoise + REAL(ReKi) :: alpstar ! nafnoise + REAL(ReKi) :: mu ! nafnoise + REAL(ReKi) :: tinooisess ! nafnoise + ! REAL(ReKi) :: L_Gammas ! nafnoise + + INTEGER(intKi) :: I !I A generic index for DO loops. + ErrStat = ErrID_None + ErrMsg = "" + + !!!--- NAF NOISE IDENTICAL + Mach = U/p%SpdSound + + ! This part is recently added for height and surface roughness dependent estimation of turbulence intensity and turbulence scales + !%Lturb=300*(Z/300)^(0.46+0.074*log(p%z0_aa)); !% Gives larger length scale + Lturb=25.d0*LE_Location**(0.35)*p%z0_aa**(-0.063) !% Gives smaller length scale ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines + ! L_Gammas=0.24+0.096*log10(p%z0_aa)+0.016*(log10(p%z0_aa))**2; !% Can be computed or just give it a value. ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines + !tinooisess=L_Gammas*log(30.d0/p%z0_aa)/log(LE_Location/p%z0_aa) !% F.E. 16% is 0.16 which is the correct input for SPLhIgh, no need to divide 100 ! ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines + tinooisess=TINoise + + !tinooisess=0.1 + !Ums = (tinooisess*U)**2 + !Ums = (tinooisess*8)**2 + CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (DBARH <= 0) THEN + SPLti = 0. + RETURN + ENDIF + + ! In the following lines, bibliography will be referenced as: a) Moriarty, Guidati, Migliore, Recent Improvement of a Semi-Empirical Aeroacoustic + ! Prediction Code for Wind Turbines + ! ref b) Lowson, Assessment and Prediction of Wind Turbine Noise + + !*********************************************** Model 1: + !!! Nafnoise source code version see below + Frequency_cutoff = 10*U/PI/Chord + Ke = 3.0/(4.0*LTurb) + Beta2 = 1-Mach*Mach + ALPSTAR = AlphaNoise*PI/180. + + DO I=1,size(p%FreqList) + IF (p%FreqList(I) <= Frequency_cutoff) THEN + Directivity = DBARL + ELSE + Directivity = DBARH + ENDIF + + WaveNumber = 2.0*PI*p%FreqList(I)/U + Kbar = WaveNumber*Chord/2.0 + Khat = WaveNumber/Ke + ! mu = Mach*WaveNumber*Chord/2.0/Beta2 + + SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound**4*LTurb*(d/2.)/ & + (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(Khat**3)* & + (1+Khat**2)**(-7./3.)*Directivity) + 78.4 ! ref a) + !!! SPLhigh = 10.*LOG10(LTurb*(d/2.)/ & + !!! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(WaveNumber**3) & + !!! *(1+WaveNumber**2)**(-7./3.)*Directivity) + 181.3 + + SPLhigh = SPLhigh + 10.*LOG10(1+ 9.0*ALPSTAR*ALPSTAR) ! Component due to angles of attack, ref a) + + Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) ! ref a) + + !!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) ! ref b) + + LFC = 10*Sears*Mach*Kbar*Kbar/Beta2 ! ref a) + !!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 ! ref b) + + !!! IF (mu<(PI/4.0)) THEN ! ref b) + !!! SPLti(I) = SPLhigh + 10.*ALOG10(LFC) ! ref b) + !!! ELSE ! ref b) + !!! SPLti(I) = SPLhigh ! ref b) + !!!ENDIF + SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) + + ENDDO + !!!*********************************************** end of Model 1 + +! ! ********************************* Model 2: +! !Wei Jun Zhu et al - !Modeling of Aerodynamically Generated Noise From Wind Turbines 2005 paper +! Beta2 = 1.d0-Mach**2; ! corresponding line: Bsq = 1.d0 - Ma**2; +! DO I=1,size(p%FreqList) +! WaveNumber = PI*p%FreqList(I)*p%SpdSound/U !corresponding line: K = pi*Freq(i)*c/Vrel; ! CarloS: This is a Mistake, c in this case is the Local Chord +! Sears = (2.d0*PI*WaveNumber/Beta2 + (1.d0+2.4d0*WaveNumber/Beta2)**(-1))**(-1); +! ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); +! LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); +! ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); +! SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) +! ! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) +! SPLti(I)=SPLti(I)*(Mach**3)*(tinooisess**2) +! ! SPLti(I)=SPLti(I)*(Mach**3)*ufluct**2 +! SPLti(I)=(SPLti(I)*(WaveNumber**3)) / ((1+WaveNumber**2)**(7/3)) +! SPLti(I)=SPLti(I)*DBARH +! SPLti(I)=10*log10(SPLti(I))+58.4 +! SPLti(I) = SPLti(I) + 10.*LOG10(LFC/(1+LFC)) +! ! SPLti(I)=10.d0*log10(DBARH*p%AirDens**2*p%SpdSound**2*Lturb*d/2.0*Mach**3*tinooisess**2* & +! !WaveNumber**3*(1.d0+WaveNumber**2)**(-7.d0/3.d0)/RObs**2)+58.4d0 + 10.d0*log10(LFC/(1+LFC)) +! ! corresponding line: SPLti(i)=10.d0*log10(Di_hi_fr*Density**2*co**2*Tbscale*L/2.0*Ma +! ! & **3*Tbinten**2*K**3*(1.d0+K**2)**(-7.d0/3.d0)/Distance**2)+58.4d0 +! ! & + 10.d0*log10(LFC/(1+LFC)); +! ! !% ver2.! +! ! Kh = 8.d0*pi*p%FreqList(i)*Lturb/(3.d0*U); +! ! SPLti(i) = 10*log10(DBARH*Lturb*0.5*d*Mach**5*tinooisess**2*Kh**3*(1+Kh**2)**(-7/3)/RObs**2) +& +! ! 10*log10(10**18.13) + 10*log10(DBARH*LFC/(1+LFC)); +! +! ENDDO +! ! ********************************* End of Model 2/ CarloSucameli: I think this model is wrong + + + +!!!! ! ********************************* Model 3: +!!!! ! ref b) Lowson, Assessment and Prediction of Wind Turbine Noise +!!!! Beta2 = 1.d0-Mach**2; ! corresponding line: Bsq = 1.d0 - Ma**2; +!!!! DO I=1,size(p%FreqList) +!!!! WaveNumber = PI*p%FreqList(I)*Chord/U !corresponding line: K = pi*Freq(i)*c/Vrel; +!!!! Sears = (2.d0*PI*WaveNumber/Beta2 + (1.d0+2.4d0*WaveNumber/Beta2)**(-1))**(-1); +!!!! ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); +!!!! LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); +!!!! ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); +!!!! SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) +!!!! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) +!!!! SPLti(I)=(SPLti(I)*(WaveNumber**3)) / ((1+WaveNumber**2)**(7./3.)) +!!!! SPLti(I)=SPLti(I)*DBARH +!!!! SPLti(I)=10*log10(SPLti(I))+58.4 +!!!! SPLti(I) = SPLti(I) + 10.*LOG10(LFC/(1+LFC)) +!!!! +!!!! +!!!! ENDDO +!!!! ! ********************************* End of Model 3 + +!!Buck&Oerlamans&Palo - !Experimental validation of a wind turbine turbulent inflow noise prediction code 2016 paper +!DO I=1,size(p%FreqList) + ! IF (p%FreqList(I) <= Frequency_cutoff) THEN + ! Directivity = DBARL + ! ELSE + ! Directivity = DBARH + ! ENDIF + ! WaveNumber = 2.0*PI*p%FreqList(I)/U ! (K) + ! Kbar = WaveNumber*Chord/2.0 + ! Khat = WaveNumber/Ke + ! SPLhigh = ( (p%AirDens**2) * (p%SpdSound**2) *d ) / (2*RObs*RObs) +! SPLhigh = SPLhigh * (Mach**3) * (dissip**(2/3)) * (WaveNumber**(-5/3)) * Directivity + ! SPLhigh = 10.*LOG10(SPLhigh) + 77.6 + ! Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) + ! LFC = 10*Sears*(1+9.0*ALPSTAR*ALPSTAR)*Mach*Kbar*Kbar/Beta2 + ! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) + !ENDDO + +! double commented lines are from FAST v4.0 aeroacoustics module. But Nafnoise version is used see above +!! Mach = U/p%SpdSound +!! +!!IF (TINoise > 0) THEN +!! Ums = (TINoise*MeanVNoise/100.)**2 ! mean square turbulence level +!!ELSE +!! SPLti = 0. +!! RETURN +!!ENDIF +!! +!! LTurb=60 +!! LTurb=0.06 +!!! temporarily commented +!!! IF (FASTHH < 30.0) THEN +!!! LTurb = 3.5*0.7*FASTHH ! Prediction sensitive to this parameter! +!!! ELSE +!!! LTurb = 3.5*21. +!!! ENDIF +!! +!!!LTurb = LTurb/100 +!! +!!! Calculate directivity...? +!!!!! ---------------------------- +!! CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large +!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!! CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) +!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!! IF (DBARH <= 0) THEN +!! SPLti = 0. +!! RETURN +!! ENDIF +!! +!! Frequency_cutoff = 10*U/PI/Chord +!! +!! IF (DBARL <= 0.) THEN +!! SPLti = 0. +!! RETURN +!! ENDIF +!! +!!DO I=1,size(p%FreqList) +!! IF (p%FreqList(I) <= Frequency_cutoff) THEN +!! Directivity = DBARL +!! ELSE +!! Directivity = DBARH +!! ENDIF +!! WaveNumber = PI*p%FreqList(I)*Chord/U +!! Beta2 = 1-Mach*Mach +!! SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*LTurb*(d/2.)/(RObs*RObs)*(Mach**3)*Ums* & +!! (WaveNumber**3)*(1+WaveNumber**2)**(-7./3.)*Directivity) + 58.4 +!! Sears = 1/(2*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) +!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 +!! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) +!! +!!ENDDO + +END SUBROUTINE InflowNoise +!==================================================================================================== +SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2,SPLBLUNT,StallVal,errStat,errMsg) + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA + REAL(ReKi), INTENT(IN ) :: C ! Chord Length + REAL(ReKi), INTENT(IN ) :: U ! Unoise + REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE --- + REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE --- + REAL(ReKi), INTENT(IN ) :: L ! SPAN METERS + REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE METERS + REAL(ReKi), INTENT(IN ) :: H ! TRAILING EDGE BLUNTNESS METERS + REAL(ReKi), INTENT(IN ) :: PSI ! TRAILING EDGE ANGLE DEGREES + REAL(ReKi), INTENT(IN ) :: d99Var2 ! + REAL(ReKi), INTENT(IN ) :: dstarVar1 ! + REAL(ReKi), INTENT(IN ) :: dstarVar2 ! + REAL(ReKi), INTENT(IN ) :: StallVal !< Stall angle at station i + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLBLUNT ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'BLUNT' + real(ReKi) :: STPPP ! STROUHAL NUMBER --- + real(ReKi) :: M ! MACH NUMBER --- + real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD --- + integer(intKi) :: I ! I A generic index for DO loops. + real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS + real(ReKi) :: DSTRS ! SUCTION SIDE DISPLACEMENT THICKNESS METERS + real(ReKi) :: DSTRP ! PRESSURE SIDE DISPLACEMENT THICKNESS METERS + real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- + real(ReKi) :: DSTRAVG ! AVERAGE DISPLACEMENT THICKNESS METERS + real(ReKi) :: HDSTAR ! BLUNTNESS OVER AVERAGE DISPLACEMENT THICKNESS --- + real(ReKi) :: DSTARH ! AVERAGE DISPLACEMENT THICKNESS OVER TRAILING EDGE BLUNTNESS --- + real(ReKi) :: ATERM ! USED TO COMPUTE PEAK STROUHAL NO. --- + real(ReKi) :: STPEAK ! PEAK STROUHAL NUMBER --- + real(ReKi) :: ETA ! RATIO OF STROUHAL NUMBERS --- + real(ReKi) :: HDSTARL ! MINIMUM ALLOWED VALUE OF HDSTAR --- + real(ReKi) :: G514 ! G5 EVALUATED AT PSI=14.0 DB + real(ReKi) :: HDSTARP ! MODIFIED VALUE OF HDSTAR --- + real(ReKi) :: G50 ! G5 EVALUATED AT PSI=0.0 DB + real(ReKi) :: G4 ! SCALED SPECTRUM LEVEL DB + ! 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 + ErrMsg = "" + + ! Reynolds number and mach number + M = U / p%SpdSound + RC = U * C/p%KinVisc + ! Compute boundary layer thicknesses + IF (p%X_BLMethod .eq. 2) THEN + DELTAP = d99Var2 + DSTRS = dstarVar1 + DSTRP = dstarVar2 + ELSE + CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + ! Compute average displacement thickness + DSTRAVG = (DSTRS + DSTRP) / 2. + HDSTAR = H / DSTRAVG + DSTARH = 1. /HDSTAR + ! Compute directivity function + CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (DBARH <= 0) THEN + SPLBLUNT = 0. + RETURN + ENDIF + ! Compute peak strouhal number eq 72 in BPM Airfoil Self-noise and Prediction paper + ATERM = .212 - .0045 * PSI + IF (HDSTAR .GE. .2) & + STPEAK = ATERM / (1.+.235*DSTARH-.0132*DSTARH**2.) ! this is what it used to be in nafnoise and fast noise module + !! 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 + ! Compute scaled spectrum level eq 74 of BPM Airfoil Self-noise and Prediction paper + IF (HDSTAR .LE. 5.) G4=17.5*LOG10(HDSTAR)+157.5-1.114*PSI + IF (HDSTAR .GT. 5.) G4=169.7 - 1.114 * PSI + ! For each frequency, compute spectrum shape referenced to 0 db + 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 + ETA = LOG10(STPPP/STPEAK) + HDSTARL = HDSTAR + CALL G5COMP(HDSTARL,ETA,G514,errStat2,errMsg2 ) ! compute G5 for Phi=14deg + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + 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 + IF (G5(I) .GT. 0.) G5(I) = 0. + G5Sum = 10**(G5(I)/10)+G5Sum ! to be subtracted + SPLBLUNT(I) = G4 + G5(I) + SCALE - 10*log10(1/G5Sum) ! equation mentioned there is plus but it is stated subtract, thus ''- 10*log10(1/G5Sum)'' + end do +END SUBROUTINE Blunt +!==================================================================================================== +SUBROUTINE G5COMP(HDSTAR,ETA,G5,errStat,errMsg) + REAL(ReKi), INTENT(IN ) :: HDSTAR !< + REAL(ReKi), INTENT(IN ) :: ETA !< + REAL(ReKi), INTENT( OUT) :: G5 !< + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + INTEGER(intKi) :: ErrStat2 ! temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message + CHARACTER(*), parameter :: RoutineName = 'BLUNT' + real(ReKi) :: K + real(ReKi) :: M + real(ReKi) :: MU + real(ReKi) :: ETALIMIT + real(ReKi) :: ETA0 + ErrStat = ErrID_None + ErrMsg = "" + IF ( HDSTAR .LT. .25) MU = .1211 ! begin eq 78 from BPM Airfoil Self-noise and Prediction paper + IF ((HDSTAR .GT. .25).AND.(HDSTAR .LE. .62)) MU =-.2175*HDSTAR + .1755 + IF ((HDSTAR .GT. .62).AND.(HDSTAR .LT. 1.15)) MU =-.0308*HDSTAR + .0596 + IF ( HDSTAR .GE. 1.15) MU = .0242 ! end + IF ( HDSTAR .LE. .02 ) M = 0.0 ! begin eq 79 from BPM Airfoil Self-noise and Prediction paper + IF ((HDSTAR .GE. .02 ).AND.(HDSTAR .LT. .5)) M = 68.724*HDSTAR - 1.35 + IF ((HDSTAR .GT. .5 ).AND.(HDSTAR .LE. .62)) M = 308.475*HDSTAR - 121.23 + IF ((HDSTAR .GT. .62 ).AND.(HDSTAR .LE. 1.15)) M = 224.811*HDSTAR - 69.354 + IF ((HDSTAR .GT. 1.15).AND.(HDSTAR .LT. 1.2)) M = 1583.28*HDSTAR - 1631.592 + IF ( HDSTAR .GT. 1.2 ) M = 268.344 + IF ( M .LT. 0.0 ) M = 0.0 ! end + ETA0 = -SQRT((M*M*MU**4)/(6.25+M*M*MU*MU)) ! eq 80 from BPM Airfoil Self-noise and Prediction paper + K = 2.5*SQRT(1.-(ETA0/MU)**2.)-2.5-M*ETA0 ! eq 81 from BPM Airfoil Self-noise and Prediction paper + ETALIMIT = 0.03615995 ! one of the bounds given in eq 76 of BPM Airfoil Self-noise and Prediction paper + IF (ETA .LE. ETA0) G5 = M * ETA + K ! begin eq 76 from BPM Airfoil Self-noise and Prediction paper + IF((ETA.GT.ETA0).AND.(ETA .LE. 0.)) G5 = 2.5*SQRT(1.-(ETA/MU)**2.)-2.5 + IF((ETA.GT.0. ).AND.(ETA.LE.ETALIMIT)) G5 = SQRT(1.5625-1194.99*ETA**2.)-1.25 + IF (ETA.GT.ETALIMIT) G5 = -155.543 * ETA + 4.375 ! end +END SUBROUTINE G5Comp +!==================================================================================================== +!> This subroutine defines the curve fit corresponding to the a-curve for the minimum allowed reynolds number. +SUBROUTINE AMIN(A,AMINA) + REAL(ReKi), INTENT(IN ) :: A + REAL(ReKi), INTENT(OUT ) :: AMINA + REAL(ReKi) :: X1 + X1 = ABS(A) + IF (X1 .LE. .204) AMINA=SQRT(67.552-886.788*X1**2.)-8.219 + IF((X1 .GT. .204).AND.(X1 .LE. .244))AMINA=-32.665*X1+3.981 + IF (X1 .GT. .244)AMINA=-142.795*X1**3.+103.656*X1**2.-57.757*X1+6.006 +END SUBROUTINE AMIN +!==================================================================================================== +!> This subroutine defines the curve fit corresponding to the a-curve for the maximum allowed reynolds number. +SUBROUTINE AMAX(A,AMAXA) + REAL(ReKi), INTENT(IN ) :: A + REAL(ReKi), INTENT(OUT ) :: AMAXA + REAL(ReKi) :: X1 + X1 = ABS(A) + IF (X1 .LE. .13)AMAXA=SQRT(67.552-886.788*X1**2.)-8.219 + IF((X1 .GT. .13).AND.(X1 .LE. .321))AMAXA=-15.901*X1+1.098 + IF (X1 .GT. .321)AMAXA=-4.669*X1**3.+3.491*X1**2.-16.699*X1+1.149 +END SUBROUTINE AMAX +!==================================================================================================== +!> This subroutine defines the curve fit corresponding to the b-curve for the minimum allowed reynolds number. +SUBROUTINE BMIN(B,BMINB) + REAL(ReKi), INTENT(IN ) :: B + REAL(ReKi), INTENT(OUT ) :: BMINB + REAL(ReKi) :: X1 + X1 = ABS(B) + IF (X1 .LE. .13)BMINB=SQRT(16.888-886.788*X1**2.)-4.109 + IF((X1 .GT. .13).AND.(X1 .LE. .145))BMINB=-83.607*X1+8.138 + IF (X1.GT..145)BMINB=-817.81*X1**3.+355.21*X1**2.-135.024*X1+10.619 +END SUBROUTINE BMin +!==================================================================================================== +!> Define the curve fit corresponding to the b-curve for the maximum allowed reynolds number. +SUBROUTINE BMAX(B,BMAXB) + REAL(ReKi), INTENT(IN ) :: B + REAL(ReKi), INTENT(OUT ) :: BMAXB + REAL(ReKi) :: X1 + X1 = ABS(B) + IF (X1 .LE. .1) BMAXB=SQRT(16.888-886.788*X1**2.)-4.109 + IF((X1 .GT. .1).AND.(X1 .LE. .187))BMAXB=-31.313*X1+1.854 + IF (X1.GT..187)BMAXB=-80.541*X1**3.+44.174*X1**2.-39.381*X1+2.344 +END SUBROUTINE BMax +!==================================================================================================== +!> Determine where the a-curve takes on a value of -20 db. +SUBROUTINE A0COMP(RC,A0) + REAL(ReKi), INTENT(IN ) :: RC + REAL(ReKi), INTENT(OUT ) :: A0 + IF (RC .LT. 9.52E+04) A0 = .57 + IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & + A0 = (-9.57E-13)*(RC-8.57E+05)**2. + 1.13 + IF (RC .GE. 8.57E+05) A0 = 1.13 +END SUBROUTINE A0COMP +!==================================================================================================== +!> 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) +!! VARIABLE NAME DEFINITION UNITS +!! ------------- ---------- ----- +!! ALPSTAR ANGLE OF ATTACK DEGREES +!! C CHORD LENGTH METERS +!! C0 SPEED OF SOUND METERS/SEC +!! DELTA0 BOUNDARY LAYER THICKNESS AT +!! ZERO ANGLE OF ATTACK METERS +!! DELTAP PRESSURE SIDE BOUNDARY LAYER +!! THICKNESS METERS +!! DSTR0 DISPLACEMENT THICKNESS AT ZERO +!! ANGLE OF ATTACK METERS +!! DSTRP PRESSURE SIDE DISPLACEMENT +!! THICKNESS METERS +!! 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 !< + REAL(ReKi), INTENT( OUT) :: DSTRP !< + REAL(ReKi), INTENT(IN ) :: StallVal !< Stall angle at station i + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Thick' + real(ReKi) :: DELTA0 ! BOUNDARY LAYER THICKNESS AT ZERO ANGLE OF ATTACK METERS + real(ReKi) :: DSTR0 ! DISPLACEMENT THICKNESS AT ZERO ANGLE OF ATTACK METERS + ErrStat = ErrID_None + ErrMsg = "" + ! + 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 + IF (p%ITRIP .EQ. 2) DELTA0=.6*DELTA0 + ! Pressure side boundary layer thickness + DELTAP = 10.**(-.04175*ALPSTAR+.00106*ALPSTAR**2.)*DELTA0 + ! Compute zero angle of attack displacement thickness + IF ((p%ITRIP .EQ. 1) .OR. (p%ITRIP .EQ. 2)) THEN + IF (RC .LE. .3E+06) DSTR0 = .0601 * RC **(-.114)*C + IF (RC .GT. .3E+06) & + DSTR0=10.**(3.411-1.5397*LOG10(RC)+.1059*LOG10(RC)**2.)*C + IF (p%ITRIP .EQ. 2) DSTR0 = DSTR0 * .6 + ELSE + 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 + ! 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 + IF (ALPSTAR .LE. 5.) DSTRS=10.**(.0679*ALPSTAR)*DSTR0 + IF((ALPSTAR .GT. 5.).AND.(ALPSTAR .LE. StallVal)) & + DSTRS = .381*10.**(.1516*ALPSTAR)*DSTR0 + IF (ALPSTAR .GT. StallVal)DSTRS=14.296*10.**(.0258*ALPSTAR)*DSTR0 + ELSE + IF (ALPSTAR .LE. 7.5)DSTRS =10.**(.0679*ALPSTAR)*DSTR0 + IF((ALPSTAR .GT. 7.5).AND.(ALPSTAR .LE. StallVal)) & + DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 + IF (ALPSTAR .GT. StallVal) DSTRS = 52.42*10.**(.0258*ALPSTAR)*DSTR0 + ENDIF +END SUBROUTINE Thick +!==================================================================================================== +!> This subroutine computes the high frequency directivity function for the input observer location +SUBROUTINE DIRECTH(M,THETA,PHI,DBAR, errStat, errMsg) + REAL(ReKi), INTENT(IN ) :: THETA ! + REAL(ReKi), INTENT(IN ) :: PHI ! + REAL(ReKi), INTENT(IN ) :: M ! + REAL(ReKi), INTENT( OUT) :: DBAR ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + ! Local variables + character(*), parameter :: RoutineName = 'Directh' + real(ReKi) :: MC + real(ReKi) :: DEGRAD + real(ReKi) :: PHIR + real(ReKi) :: THETAR + ErrStat = ErrID_None + ErrMsg = "" + DEGRAD = .017453 + MC = .8 * M + THETAR = THETA * DEGRAD + PHIR = PHI * DEGRAD + DBAR = 2.*SIN(THETAR/2.)**2.*SIN(PHIR)**2./((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2.) ! eq B1 in BPM Airfoil Self-noise and Prediction paper +END SUBROUTINE DirectH +!==================================================================================================== +!> This subroutine computes the high frequency directivity function for the input observer location +! Paper: +SUBROUTINE DIRECTL(M,THETA,PHI,DBAR, errStat, errMsg) + REAL(ReKi), INTENT(IN ) :: THETA !< + REAL(ReKi), INTENT(IN ) :: PHI !< + REAL(ReKi), INTENT(IN ) :: M !< + REAL(ReKi), INTENT( OUT) :: DBAR !< + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + character(*), parameter :: RoutineName = 'DirectL' + real(ReKi) :: MC + real(ReKi) :: DEGRAD + real(ReKi) :: PHIR + real(ReKi) :: THETAR + ErrStat = ErrID_None + ErrMsg = "" + ! This subroutine computes the low frequency directivity function for the input observer location + DEGRAD = .017453 + MC = .8 * M + THETAR = THETA * DEGRAD + PHIR = PHI * DEGRAD + DBAR = (SIN(THETAR)*SIN(PHIR))**2/(1.+M*COS(THETAR))**4 ! eq B2 in BPM Airfoil Self-noise and Prediction paper +END SUBROUTINE DirectL +!==================================================================================================================================! +!=============================== Simplified Guidati Inflow Turbulence Noise Addition =============================================! +!==================================================================================================================================! +! Uses simple correction for turbulent inflow noise from Moriarty et. al 2005 +! Paper: Prediction of Turbulent Inflow and Trailing-Edge Noise for Wind Turbines, by Moriarty, Guidati, and Migliore +SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti,errStat,errMsg) + REAL(ReKi), INTENT(IN ) :: U ! Vrel + REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length + REAL(ReKi), INTENT(IN ) :: thick_10p ! + REAL(ReKi), INTENT(IN ) :: thick_1p ! + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + ! local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Simple_Guidati' + INTEGER(intKi) :: loop1 ! temporary + REAL(ReKi) :: TI_Param ! Temporary variable thickness ratio dependent + REAL(ReKi) :: slope ! Temporary variable thickness ratio dependent + ErrStat = ErrID_None + ErrMsg = "" + + TI_Param = thick_1p + thick_10p ! Eq 2 + slope = 1.123*TI_Param + 5.317*TI_Param*TI_Param ! Eq 3 + do loop1 =1,size(p%FreqList) + SPLti(loop1) = -slope*(2*PI*p%FreqList(loop1)*chord/U + 5.0d0) ! Eq 4 + enddo ! Outputs Delta_SPL, the difference in SPL between the airfoil and a flat plate. +END SUBROUTINE Simple_Guidati +!==================================================================================================================================! +!================================ Turbulent Boundary Layer Trailing Edge Noise ====================================================! +!=================================================== TNO START ====================================================================! +SUBROUTINE TBLTE_TNO(ALPSTAR,C,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) + REAL(ReKi), INTENT(IN ) :: D !< SPAN (m) + REAL(ReKi), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE (m) + REAL(ReKi),DIMENSION(2), INTENT(IN ) :: Cfall !< Skin friction coefficient (-) + REAL(ReKi),DIMENSION(2), INTENT(IN ) :: d99all !< + REAL(ReKi),DIMENSION(2), INTENT(IN ) :: EdgeVelAll !< + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Noise Module Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT(IN ) :: SPLALPH !< SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP !< SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS !< SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL !< TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + character(*), INTENT( OUT) :: errMsgn !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'TBLTE_TNO' + REAL(ReKi) :: answer + REAL(ReKi) :: Spectrum + REAL(ReKi) :: freq(size(p%FreqList)) + REAL(ReKi) :: SPL_press,SPL_suction + REAL(ReKi) :: band_width,band_ratio + REAL(ReKi) :: DBARH + REAL(ReKi) :: P1,P2,P4 + INTEGER (4) :: n_freq + INTEGER (4) :: i_omega + + ! Variables passed to integration routine + real(ReKi) :: int_limits(2) !< Lower and upper integration limits + real(ReKi) :: Mach !< Mach number + real(ReKi) :: omega + + ! Init + n_freq = size(p%FreqList) + freq = p%FreqList + ErrStat = ErrID_None + ErrMsgn = "" + ! Body of TNO + band_ratio = 2.**(1./3.) + + ! Mach number + Mach = U / p%SpdSound + + ! Directivity function + CALL DIRECTH(REAL(Mach),THETA,PHI,DBARH,errStat2,errMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsgn, RoutineName ) + + do i_omega = 1,n_freq + omega = 2.*pi*freq(i_omega) + !integration limits + int_limits(1) = 0.0e0 + int_limits(2) = 10*omega/(Mach*p%SpdSound) + ! Convert to third octave + band_width = freq(i_omega)*(sqrt(band_ratio)-1./sqrt(band_ratio)) * 4. * pi + IF (Cfall(1) .GT. 0.) THEN + answer = SPL_integrate(omega=omega,limits=int_limits,ISSUCTION=.true., & + Mach=Mach,SpdSound=p%SpdSound,AirDens=p%AirDens,KinVisc=p%KinVisc, & + Cfall=Cfall,d99all=d99all,EdgeVelAll=EdgeVelAll) + 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 + + IF (Cfall(2) .GT. 0.) THEN + 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 + SPL_press = 10.*log10(Spectrum*DBARH/2.e-5/2.e-5) + SPLP(i_omega) = SPL_press + 10.*log10(band_width) + ENDIF + + ! Sum the noise sources SPLALPH is BPM value + IF (SPLP(i_omega) .LT. -100.) SPLP(i_omega) = -100. + IF (SPLS(i_omega) .LT. -100.) SPLS(i_omega) = -100. + + P1 = 10.**(SPLP(i_omega) / 10.) + P2 = 10.**(SPLS(i_omega) / 10.) + P4 = 10.**(SPLALPH(i_omega) / 10.) + SPLTBL(i_omega) = 10. * LOG10(P1 + P2 + P4) + enddo +END SUBROUTINE TBLTE_TNO + + +!==================================================================================================== +SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) + REAL(ReKi), INTENT(IN ) :: U !< METERS/SEC + REAL(ReKi), INTENT(IN ) :: AlphaNoise !< Angle of Attack DEG + REAL(ReKi), INTENT(IN ) :: C !< Chord METERS + integer(intKi), INTENT(IN ) :: whichairfoil !< whichairfoil + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'BL_Param_Interp' + REAL(ReKi) :: redif1,redif2,aoadif1,aoadif2,xx1,xx2,RC + INTEGER(intKi) :: loop1,loop2 + logical :: re_flag + ErrStat = ErrID_None + ErrMsg = "" + + !!!! this if is not used but if necessary two sets of tables can be populated for tripped and untripped cases + RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD + + re_flag = .FALSE. + DO loop1=1,size(p%ReListBL)-1 + IF ( (RC.le.p%ReListBL(loop1+1)) .and. (RC.gt.p%ReListBL(loop1)) ) then + re_flag = .TRUE. + redif1=abs(RC-p%ReListBL(loop1+1)) + redif2=abs(RC-p%ReListBL(loop1)) + DO loop2=1,size(p%AOAListBL)-1 + + if ( (AlphaNoise.le.p%AOAListBL(loop2+1)) .and. (AlphaNoise.gt.p%AOAListBL(loop2)) ) then + aoadif1=abs(AlphaNoise-p%AOAListBL(loop2+1)) + aoadif2=abs(AlphaNoise-p%AOAListBL(loop2)) + + xx1=( p%dstarall1(loop2,loop1+1,whichairfoil)*redif2+p%dstarall1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%dstarall1(loop2+1,loop1+1,whichairfoil)*redif2+p%dstarall1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%dstarVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%dstarall2(loop2,loop1+1,whichairfoil)*redif2+p%dstarall2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%dstarall2(loop2+1,loop1+1,whichairfoil)*redif2+p%dstarall2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%dstarVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%d99all1(loop2,loop1+1,whichairfoil)*redif2+p%d99all1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%d99all1(loop2+1,loop1+1,whichairfoil)*redif2+p%d99all1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%d99Var(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%d99all2(loop2,loop1+1,whichairfoil)*redif2+p%d99all2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%d99all2(loop2+1,loop1+1,whichairfoil)*redif2+p%d99all2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%d99Var(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%Cfall1(loop2,loop1+1,whichairfoil)*redif2+p%Cfall1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%Cfall1(loop2+1,loop1+1,whichairfoil)*redif2+p%Cfall1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%CfVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%Cfall2(loop2,loop1+1,whichairfoil)*redif2+p%Cfall2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%Cfall2(loop2+1,loop1+1,whichairfoil)*redif2+p%Cfall2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%CfVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%EdgeVelRat1(loop2,loop1+1,whichairfoil)*redif2+p%EdgeVelRat1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2+p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%EdgeVelVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + xx1=( p%EdgeVelRat2(loop2,loop1+1,whichairfoil)*redif2+p%EdgeVelRat2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + xx2=( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2+p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%EdgeVelVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) + + return ! We exit the routine ! + endif + if (loop2 .eq. (size(p%AOAListBL)-1) ) then + + if (AlphaNoise .gt. p%AOAListBL(size(p%AOAListBL))) then + 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) + m%dStarVar (1) = ( p%dstarall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%dStarVar (2) = ( p%dstarall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%d99Var (1) = ( p%d99all1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%d99Var (2) = ( p%d99all2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%CfVar (1) = ( p%Cfall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%Cfall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%CfVar (2) = ( p%Cfall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%Cfall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%EdgeVelVar(1) = ( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + m%EdgeVelVar(2) = ( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) + elseif (AlphaNoise .lt. p%AOAListBL(1)) then + 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) + m%dStarVar(1) = ( p%dstarall1 (1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%dStarVar(2) = ( p%dstarall2 (1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%d99Var(1) = ( p%d99all1 (1,loop1+1,whichairfoil)*redif2 + p%d99all1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%d99Var(2) = ( p%d99all2 (1,loop1+1,whichairfoil)*redif2 + p%d99all2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%CfVar(1) = ( p%Cfall1 (1,loop1+1,whichairfoil)*redif2 + p%Cfall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%CfVar(2) = ( p%Cfall2 (1,loop1+1,whichairfoil)*redif2 + p%Cfall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%EdgeVelVar(1) = ( p%EdgeVelRat1(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + m%EdgeVelVar(2) = ( p%EdgeVelRat2(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) + endif + endif + enddo + endif + enddo + if (.not. re_flag) then + call SetErrStat( ErrID_Fatal, 'Warning AeroAcoustics Module - the Reynolds number is not in the range provided by the user. Code stopping.', ErrStat, ErrMsg, RoutineName ) + stop + endif +END SUBROUTINE BL_Param_Interp + + +SUBROUTINE Aero_Tests() + !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! + !CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + ! elementspan,m%rTEtoObserve(K,J,I), & + ! p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,ErrStat2,errMsg2) + !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! + !CALL TBLTE(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & + ! p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I),m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2,errMsg2 ) + !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, & + ! m%CfVar,m%d99var,m%EdgeVelVar, p, m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2 ,errMsg2) + !--------Blunt Trailing Edge Noise----------------------------------------------! + !CALL BLUNT(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0,& + ! p%TEThick(J,I),p%TEAngle(J,I),p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,ErrStat2,errMsg2 ) + !--------Tip Noise--------------------------------------------------------------! + !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 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 ) +END SUBROUTINE +END MODULE AeroAcoustics + diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 new file mode 100644 index 0000000000..742d1235c5 --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -0,0 +1,987 @@ +!********************************************************************************************************************************** +! File last committed: 2020-02-12 +!********************************************************************************************************************************** +MODULE AeroAcoustics_IO + + use NWTC_Library + use AeroAcoustics_Types + + implicit none + + type(ProgDesc), parameter :: AA_Ver = ProgDesc( 'AeroAcoustics', 'v1.00.00', '18-Aug-2016' ) + character(*), parameter :: AA_Nickname = 'AA' + + + + 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 + integer(intKi), parameter :: ModelUnknown = -1 + +! FLAG TO COMPUTE BLUNTNESS NOISE = 0 No, =1 Yes + integer(intKi), parameter :: IBLUNT_None = 0 + integer(intKi), parameter :: IBLUNT_BPM = 1 + +! FLAG TO COMPUTE Laminar Boundary Layer Noise = 0 No, =1 Yes + integer(intKi), parameter :: ILAM_None = 0 ! steady model + integer(intKi), parameter :: ILAM_BPM = 1 ! + +! FLAG TO COMPUTE Tip Noise = 0 No, =1 Yes + integer(intKi), parameter :: ITIP_None = 0 ! + integer(intKi), parameter :: ITIP_On = 1 ! + + integer(intKi), parameter :: ITRIP_None = 0 ! not tripped boundary layer + integer(intKi), parameter :: ITRIP_Heavy = 1 ! heavily tripped boundary layer + integer(intKi), parameter :: ITRIP_Light = 2 ! light tripped boundary layer + +! calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated BL values + integer(intKi), parameter :: X_BLMethod_BPM = 1 ! + integer(intKi), parameter :: X_BLMethod_Tables = 2 ! + + integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated + integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically + + integer(intKi), parameter :: ITURB_None = 0 ! TBLTE noise is not calculated + integer(intKi), parameter :: ITURB_BPM = 1 ! TBLTE noise is calculated with BPM + integer(intKi), parameter :: ITURB_TNO = 2 ! TBLTE noise is calculated with TNO + + integer(intKi), parameter :: IInflow_None = 0 ! IInflow noise is not calculated + integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM + integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati + integer(intKi), parameter :: IInflow_SimpleGuidati = 3 ! IInflow noise is calculated with SimpleGuidati + +contains +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadInputFiles( InputFileName, BL_Files, InputFileData, Default_DT, OutFileRoot, NumBlades, 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 + 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(1024) :: AABlFile(MaxBl) ! File that contains the blade information (specified in the primary input file) + CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' + ! initialize values: + ErrStat = ErrID_None + ErrMsg = '' + UnEcho = -1 + + + ! Reads the module input-file data + CALL ReadPrimaryFile( InputFileName, InputFileData, AABlFile, Default_DT, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) + if(Failed()) return + + ! get the blade input-file data + ALLOCATE( InputFileData%BladeProps( NumBlades ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) + return + END IF + + do i = 1,NumBlades + CALL ReadBladeInputs ( AABlFile(i), InputFileData%BladeProps(i), UnEcho, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) + if(Failed()) return + end do + + if ((InputFileData%ITURB.eq.2) .or. (InputFileData%X_BLMethod.eq.2)) then + ! We need to read the BL tables + CALL ReadBLTables( InputFileName, BL_Files, InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) + if (Failed())return + endif + + IF( (InputFileData%TICalcMeth.eq.1) ) THEN + CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2); if(Failed()) return + ENDIF + +CONTAINS + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + +END SUBROUTINE ReadInputFiles +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine reads in the primary Noise input file and places the values it reads in the InputFileData structure. +! It opens and prints to an echo file if requested. +SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, Default_DT, OutFileRoot, UnEc, ErrStat, ErrMsg ) + integer(IntKi), intent(out) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. + integer(IntKi), intent(out) :: ErrStat ! Error status + REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) + character(*), intent(out) :: AABlFile(MaxBl) ! name of the files containing blade inputs + character(*), intent(in) :: InputFile ! Name of the file containing the primary input data + character(*), intent(out) :: ErrMsg ! Error message + character(*), intent(in) :: OutFileRoot ! The rootname of the echo file, possibly opened in this routine + type(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 + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + 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 = "" + + UnEc = -1 + Echo = .FALSE. + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + ! Open the Primary input file. + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ); call check + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ); call check + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! Read the lines up/including to the "Echo" simulation control variable + ! If echo is FALSE, don't write these lines to the echo file. + ! If Echo is TRUE, rewind and write on the second try. + I = 1 !set the number of times we've read the file + DO + !----------- HEADER ------------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'File header: 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 + ! Echo - Echo input to ".AD.ech". + 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 + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(AA_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' + REWIND( UnIn, IOSTAT=ErrStat2 ) + IF (ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + END IF + END DO + + IF (NWTC_VerboseLevel == NWTC_Verbose) THEN + CALL WrScr( ' Heading of the '//TRIM(AA_Ver%Name)//' input file: ' ) + CALL WrScr( ' '//TRIM( InputFileData%FTitle ) ) + END IF + + ! DT_AA - Time interval for aerodynamic calculations {or default} (s): + Line = "" + CALL ReadVar( UnIn, InputFile, Line, "DT_AA", "Time interval for aeroacoustics calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc); call check + CALL Conv2UC( Line ) + + IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If DT_AA is not "default", read it and make sure it is a multiple of DTAero from AeroDyn. Else, just use DTAero + READ( Line, *, IOSTAT=IOS) InputFileData%DT_AA + CALL CheckIOS ( IOS, InputFile, 'DT_AA', NumType, ErrStat2, ErrMsg2 ); call check + + IF (abs(InputFileData%DT_AA / Default_DT - NINT(InputFileData%DT_AA / Default_DT)) .gt. 1E-10) THEN + CALL SetErrStat(ErrID_Fatal,"The Aeroacoustics input DT_AA must be a multiple of DTAero.", ErrStat, ErrMsg, RoutineName) + return + END IF + ELSE + InputFileData%DT_AA = Default_DT + 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%z0_AA ,"SurfRoughness","" ,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 + + ! AABlFile - Names of files containing distributed aerodynamic properties for each blade (see AA_BladeInputFile type): + DO I = 1,MaxBl + CALL ReadVar ( UnIn, InputFile, AABlFile(I), 'AABlFile('//TRIM(Num2Lstr(I))//')', 'Name of file containing distributed aerodynamic properties for blade '//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ); call check + IF ( PathIsRelative( AABlFile(I) ) ) AABlFile(I) = TRIM(PriPath)//TRIM(AABlFile(I)) + END DO + + ! Return on error at end of section + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + !----------- OBSERVER INPUT ------------------------------ + 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 + IF ( PathIsRelative( ObserverFile ) ) ObserverFile = TRIM(PriPath)//TRIM(ObserverFile) + + CALL GetNewUnit( UnIn2, ErrStat2, ErrMsg2 ); call check + + CALL OpenFInpFile ( UnIn2, ObserverFile, ErrStat2, ErrMsg2 ); call check + IF ( ErrStat >= AbortErrLev ) RETURN + + ! NrObsLoc - Nr of Observers (-): + 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 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 + ! Return on error if we couldn't read this line + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + ENDDO + CLOSE ( UnIn2 ) + !----- 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 + 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" + ENDDO + + ! Return on error at end of section + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + !---------------------- END OF FILE ----------------------------------------- + CALL Cleanup( ) + +CONTAINS + SUBROUTINE Check() + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE Check + + !............................................................................................................................... + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE ( UnIn ) + END SUBROUTINE Cleanup + !............................................................................................................................... +END SUBROUTINE ReadPrimaryFile +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine reads a blade input file. +SUBROUTINE ReadBladeInputs ( AABlFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) + TYPE(AA_BladePropsType), INTENT(INOUT) :: BladeKInputFileData ! Data for Blade K stored in the module's input file + CHARACTER(*), INTENT(IN) :: AABlFile ! Name of the blade input file data + INTEGER(IntKi), INTENT(IN) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc + INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message + ! Local variables: + INTEGER(IntKi) :: I ! A generic DO index. + INTEGER( IntKi ) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg + CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' + ErrStat = ErrID_None + ErrMsg = "" + UnIn = -1 + ! Allocate space for these variables + CALL GetNewUnit (UnIn, ErrStat2, ErrMsg2 ); if(Failed()) return + CALL OpenFInpFile (UnIn, AABlFile, ErrStat2, ErrMsg2 ); if(Failed()) return + ! -------------- HEADER ------------------------------------------------------- + ! Skip the header. + CALL ReadCom ( UnIn, AABlFile, 'unused blade file header line 1', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom ( UnIn, AABlFile, 'unused blade file header line 2', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + ! -------------- Blade properties table ------------------------------------------ + CALL ReadCom ( UnIn, AABlFile, 'Section header: Blade Properties', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + ! NumBlNds - Number of blade nodes used in the analysis (-): + CALL ReadVar( UnIn, AABlFile, BladeKInputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc); if(Failed()) return + CALL ReadCom ( UnIn, AABlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom ( UnIn, AABlFile, 'Table header: units', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + ! allocate space for blade inputs: + CALL AllocAry(BladeKInputFileData%TEAngle ,BladeKInputFileData%NumBlNds,'TEAngle' ,ErrStat2,ErrMsg2); if(Failed()) return + CALL AllocAry(BladeKInputFileData%TEThick ,BladeKInputFileData%NumBlNds,'TEThick' ,ErrStat2,ErrMsg2); if(Failed()) return + CALL AllocAry(BladeKInputFileData%StallStart,BladeKInputFileData%NumBlNds,'StallStart',ErrStat2,ErrMsg2); if(Failed()) return + DO I=1,BladeKInputFileData%NumBlNds + READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%TEAngle(I), BladeKInputFileData%TEThick(I) + CALL CheckIOS( IOS, AABlFile, 'Blade properties row '//TRIM(Num2LStr(I)), NumType, ErrStat2, ErrMsg2); if(Failed()) return + IF (UnEc > 0) THEN + WRITE( UnEc, "(6(F9.4,1x),I9)", IOStat=IOS) BladeKInputFileData%TEAngle(I), BladeKInputFileData%TEThick(I) + END IF + END DO + ! -------------- END OF FILE -------------------------------------------- + CALL Cleanup() +CONTAINS + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE(UnIn) + END SUBROUTINE Cleanup +END SUBROUTINE ReadBladeInputs + +! ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + +subroutine ReadRealMatrix(fid, FileName, Mat, VarName, nLines,nRows, iStat, Msg, iLine ) + integer, intent(in) :: fid + real(DbKi), dimension(:,:), allocatable :: Mat + character(len=*), intent(in) :: FileName + character(len=*), intent(in) :: VarName + integer, intent(in) :: nLines + integer, intent(in) :: nRows + integer, intent(out) :: iStat + integer, intent(inout) :: iLine + character(len=*), intent(inout) :: Msg + ! local variables + integer :: i + if (allocated(Mat)) deallocate(Mat) + call allocAry( Mat, nLines, nRows, VarName, iStat, Msg); + if (iStat /= 0) return + !Read Stiffness + DO I =1,nLines + iLine=iLine+1 + ! TODO use ReadCAryFromStr when available in the NWTCIO, it performs more checks + CALL ReadAry( fid, FileName, Mat(I,:), nRows, trim(VarName)//' Line '//Num2LStr(iLine), VarName, iStat, Msg) ! From NWTC_Library + if (iStat /= 0) return + ENDDO +end subroutine + + + +SUBROUTINE ReadBLTables( InputFile,BL_Files,InputFileData, nAirfoils, 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 + integer(IntKi), intent(in) :: nAirfoils ! Number of Airfoil tables + 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 + 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 ! Number of Reynolds number and angle of attack listed + integer(IntKi) :: iAF , iRe, iAoA, iDummy, iBuffer ! loop counters + real(DbKi),dimension(:,:),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. + + do iAF=1,nAirfoils + + FileName = trim(BL_Files(iAF)) + + print*,'AeroAcoustics_IO: reading BL table:'//trim(Filename) + + CALL GetNewUnit(UnIn, ErrStat2, ErrMsg2); if(Failed()) return + CALL OpenFInpFile(UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return + + CALL ReadCom(UnIn, FileName, "! Boundary layer", ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadCom(UnIn, FileName, "! Legend: aoa", ErrStat2, ErrMsg2); if(Failed()) return + + CALL ReadVar(UnIn, FileName, nRe, "ReListBL", "", ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadVar(UnIn, FileName, nAoA, "aoaListBL", "", ErrStat2, ErrMsg2); if(Failed()) return + + if (iAF==1) then + CALL AllocAry(InputFileData%Pres_DispThick ,nAoA,nRe,nAirfoils,'InputFileData%Pres_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_DispThick ,nAoA,nRe,nAirfoils,'InputFileData%Suct_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_BLThick ,nAoA,nRe,nAirfoils,'InputFileData%Pres_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_BLThick ,nAoA,nRe,nAirfoils,'InputFileData%Suct_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_Cf ,nAoA,nRe,nAirfoils,'InputFileData%Pres_Cf' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_Cf ,nAoA,nRe,nAirfoils,'InputFileData%Suct_Cf' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_EdgeVelRat,nAoA,nRe,nAirfoils,'InputFileData%Pres_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_EdgeVelRat,nAoA,nRe,nAirfoils,'InputFileData%Suct_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return + + CALL AllocAry(InputFileData%ReListBL,nRe,'InputFileData%ReListBL',ErrStat2,ErrMsg2); if (Failed())return + + + CALL AllocAry(Buffer,nAoA,9, 'Buffer', ErrStat2, ErrMsg2); if(Failed()) return + endif + iLine=8 + do iRe=1,nRe + CALL ReadVar(UnIn, FileName, InputFileData%ReListBL(iRe), 'InputFileData%ReListBL','ReListBL', ErrStat2, ErrMsg2); if(Failed()) return + InputFileData%ReListBL(iRe) = InputFileData%ReListBL(iRe) * 1.e+006 + CALL ReadCom(UnIn, FileName, "aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Theta_SS Theta_PS Cf_SS Cf_PS", ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadCom(UnIn, FileName, "(deg) (-) (-) (-) (-) (-) (-) (-) (-)", ErrStat2, ErrMsg2); if(Failed()) return + + call ReadRealMatrix(UnIn, FileName, Buffer, 'BL Matrix', nAoA, 9, ErrStat2, ErrMsg2, iLine) + + if(Failed()) return + do iAoA=1,nAoA + InputFileData%Suct_EdgeVelRat(iAoA,iRe,iAF)= Buffer(iAoA, 2) ! EdgeVelRat1 Suction + InputFileData%Pres_EdgeVelRat(iAoA,iRe,iAF)= Buffer(iAoA, 3) ! EdgeVelRat2 Pressure + InputFileData%Suct_DispThick (iAoA,iRe,iAF)= Buffer(iAoA, 4) ! dStarAll1 Suction + InputFileData%Pres_DispThick (iAoA,iRe,iAF)= Buffer(iAoA, 5) ! dStarAll2 Pressure + InputFileData%Suct_BLThick (iAoA,iRe,iAF)= Buffer(iAoA, 6) ! d99All1 Suction + InputFileData%Pres_BLThick (iAoA,iRe,iAF)= Buffer(iAoA, 7) ! d99All2 Pressure + InputFileData%Suct_Cf (iAoA,iRe,iAF)= Buffer(iAoA, 8) ! CfAll1 Suction + InputFileData%Pres_Cf (iAoA,iRe,iAF)= Buffer(iAoA, 9) ! CfAll2 Pressure + enddo + enddo + + if (iAF == 1) then + CALL AllocAry(InputFileData%AoAListBL,nAoA, 'InputFileData%AoAListBL', ErrStat2, ErrMsg2); if(Failed()) return + do iAoA=1,nAoA + InputFileData%AoAListBL(iAoA)= Buffer(iAoA, 1) ! AoA + enddo + endif + + enddo + CALL Cleanup( ) +CONTAINS + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE ( UnIn ) + END SUBROUTINE Cleanup +END SUBROUTINE ReadBLTables +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) + ! Passed variables + integer(IntKi), intent(out) :: ErrStat ! Error status + character(*), intent(out) :: ErrMsg ! Error message + type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file + character(*), intent(in) :: InputFile ! Name of the file containing the primary input data + ! Local variables: + integer(IntKi) :: 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 + 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 ! + integer(IntKi) :: cou1 + ! Initialize some variables: + ErrStat = ErrID_None + ErrMsg = "" + + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + FileName = TRIM(PriPath)//InputFileData%TICalcTabFile + + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() + CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return + + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2);call check + CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check + if(Failed()) return + + CALL AllocAry( InputFileData%TI_Grid_In,GridZ,GridY,'InputFileData%TI_Grid_In', ErrStat2, ErrMsg2); + if(Failed()) return + DO cou1=1,size(InputFileData%TI_Grid_In,1) + read(UnIn,*) InputFileData%TI_Grid_In(cou1,:) + ENDDO + !---------------------- END OF FILE ----------------------------------------- + CALL Cleanup( ) + +CONTAINS + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + SUBROUTINE Check() + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE Check + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE ( UnIn ) + END SUBROUTINE Cleanup +END SUBROUTINE REadTICalcTables +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates the inputs from the AeroDyn input files. +SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) + type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file + integer(IntKi), intent(in) :: NumBl !< Number of blades + 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 = "" + if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) + if (InputFileData%DT_AA <= 0.0) call SetErrStat ( ErrID_Fatal, 'DT_AA must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%IBLUNT /= IBLUNT_None .and. InputFileData%IBLUNT /= IBLUNT_BPM) then + call SetErrStat ( ErrID_Fatal, & + 'IBLUNT must '//trim(num2lstr(IBLUNT_None))//' (none) or '//trim(num2lstr(IBLUNT_BPM))//' (Bluntness noise calculated).', ErrStat, ErrMsg, RoutineName ) + endif + if (InputFileData%ILAM /= ILAM_None .and. InputFileData%ilam /= ILAM_BPM) then + call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& + trim(num2lstr(ILAM_BPM))//' (ILAM Calculated).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%ITIP /= ITIP_None .and. InputFileData%ITIP /= ITIP_ON) then + call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& + trim(num2lstr(ITIP_On))//' (ITIP On).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%ITRIP /= ITRIP_None .and. InputFileData%ITRIP /= ITRIP_Heavy .and. InputFileData%ITRIP /= ITRIP_Light) then + call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& + ' (heavily tripped BL Calculation) or '//trim(num2lstr(ITRIP_Light))//' (lightly tripped BL)' ,ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%ITURB /= ITURB_None .and. InputFileData%ITURB /= ITURB_BPM .and. InputFileData%ITURB /= ITURB_TNO) then + call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%IInflow /= IInflow_None .and. InputFileData%IInflow /= IInflow_BPM & + .and. InputFileData%IInflow /= IInflow_FullGuidati .and. InputFileData%IInflow /= IInflow_SimpleGuidati ) then + call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& + 'or 3 (Simple Guidati).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%TICalcMeth /= TICalc_Every .and. InputFileData%TICalcMeth /= TICalc_Interp ) then + call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' TICalc automatic or '//& + trim(num2lstr(TICalc_Interp))//' (TICalcMeth interp).', ErrStat, ErrMsg, RoutineName ) + end if + + if (InputFileData%X_BLMethod /= X_BLMethod_BPM .and. InputFileData%X_BLMethod /= X_BLMethod_Tables) then + call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& + trim(num2lstr(X_BLMethod_Tables))//' (X_BLMethod with BL tables).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%NrObsLoc <= 0.0) call SetErrStat ( ErrID_Fatal, 'Number of Observer Locations should be greater than zero', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 & + .and. InputFileData%NrOutFile /= 4) then + call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) + end if +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) + 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 + ! Local variables + 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 + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + InitOut%AirDens = p%AirDens + ! FIRST FILE HEADER,UNIT + call AllocAry(InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + do j=1,p%NrObsLoc + InitOut%WriteOutputHdr(j)="Obs"//trim(num2lstr(j)) + InitOut%WriteOutputUnt(j) = "OASPL" + enddo + + ! SECOND FILE HEADER,UNIT + call AllocAry(InitOut%WriteOutputHdrforPE, p%numOutsforPE, 'WriteOutputHdrforPE', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUntforPE, p%numOutsforPE, 'WriteOutputUntforPE', errStat2, errMsg2); if(Failed()) return + i=0 + do j=1,p%NrObsLoc + do k=1,size(p%FreqList) + i=i+1 + InitOut%WriteOutputHdrforPE(i) = "Obs"//trim(num2lstr(j))//"_Freq"//trim(num2lstr(p%FreqList(k))) + if(p%aweightflag .eqv. .TRUE.) then + InitOut%WriteOutputUntforPE(i) = "SPL_A" + else + InitOut%WriteOutputUntforPE(i) = "SPL" + endif + end do + enddo + ! THIRD FILE HEADER,UNIT + call AllocAry(InitOut%WriteOutputHdrSep, p%NumOutsForSep, 'WriteOutputHdrSep', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUntSep, p%NumOutsForSep, 'WriteOutputUntSep', errStat2, errMsg2); if(Failed()) return + i=0 + do j=1,p%NrObsLoc + do k=1,size(p%FreqList) + do oi=1,7 + i=i+1 + InitOut%WriteOutputHdrSep(i) = "Obs"//trim(num2lstr(j))//"_Freq"//trim(num2lstr(p%FreqList(k)))//"_Type"//trim(num2lstr(oi)) + InitOut%WriteOutputHdrSep(i)=trim(InitOut%WriteOutputHdrSep(i)) + if(p%aweightflag .eqv. .TRUE.) then + InitOut%WriteOutputUntSep(i) = "SPL_A" + else + InitOut%WriteOutputUntSep(i) = "SPL" + endif + enddo + enddo + enddo + + ! FOURTH FILE HEADER,UNIT + call AllocAry(InitOut%WriteOutputHdrNodes,p%numBlades*p%NumBlNds*p%NrObsLoc, 'InitOut%WriteOutputHdrNodes', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUntNodes,p%numBlades*p%NumBlNds*p%NrObsLoc, 'InitOut%WriteOutputUntNodes', errStat2, errMsg2); if(Failed()) return + i=0 + do oi = 1,p%numBlades + do k = 1,p%NumBlNds + do j = 1,p%NrObsLoc + i=i+1 + InitOut%WriteOutputHdrNodes(i) = "Bld"//trim(num2lstr(oi))//"Node"//trim(num2lstr(k))//"Obs"//trim(num2lstr(j)) + InitOut%WriteOutputUntNodes(i) = "SPL" + enddo + enddo + enddo + InitOut%Ver = AA_Ver + InitOut%delim = Tab + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine AA_SetInitOut +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine AA_InitializeOutputFile(p, InputFileData,InitOut,errStat, errMsg) + type(AA_InputFile), intent(in ) :: InputFileData !< All the data in the AeroDyn input file + type(AA_ParameterType) , intent(inout) :: p !< + type(AA_InitOutputType), intent(in ) :: InitOut !< output data + integer(IntKi) , intent(inout) :: errStat !< Status of error message + character(*) , intent(inout) :: errMsg !< Error message if ErrStat /= ErrID_None + ! locals + 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 ) + if ( ErrStat >= AbortErrLev ) then + p%unOutFile = -1 + return + end if + + call OpenFOutFile ( p%unOutFile, trim(InputFileData%AAOutFile(1)), ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) return + + write (p%unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%ver)) + write (p%unOutFile,'(A)') '' + write( p%unOutFile,'(A,I5)' ) 'Number of observers :', p%NrObsLoc + write (p%unOutFile,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) + write (p%unOutFile,'(A)') '' + numOuts = size(InitOut%WriteOutputHdr) + !...................................................... + ! Write the names of the output parameters on one line: line 7 + !...................................................... + call WrFileNR ( p%unOutFile, ' Time ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile, InitOut%delim//InitOut%WriteOutputHdr(i) ) + end do ! i + write (p%unOutFile,'()') + !...................................................... + ! Write the units of the output parameters on one line: line 8 + !...................................................... + call WrFileNR ( p%unOutFile, ' (s) ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile, InitOut%delim//InitOut%WriteOutputUnt(i) ) + end do ! i + write (p%unOutFile,'()') + ENDIF + ! SECOND FILE + IF (InputFileData%NrOutFile .gt. 1) THEN + call GetNewUnit( p%unOutFile2, ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) then + p%unOutFile = -1 + return + end if + call OpenFOutFile ( p%unOutFile2, trim(InputFileData%AAOutFile(2)), ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) return + write (p%unOutFile2,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%Ver)) + write (p%unOutFile2,'(A)') '' + write( p%unOutFile2,'(A,I5,A,I5)' ) 'Number of observers :', p%NrObsLoc,'; Number of frequencies :', size(p%FreqList) + write (p%unOutFile2,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) + write (p%unOutFile2,'(A)') '' + numOuts = size(InitOut%WriteOutputHdrforPE) + !...................................................... + ! Write the names of the output parameters on one line: line 7 + !...................................................... + call WrFileNR ( p%unOutFile2, ' Time ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile2, InitOut%delim//InitOut%WriteOutputHdrforPE(i) ) + end do ! i + write (p%unOutFile2,'()') + !...................................................... + ! Write the units of the output parameters on one line: line 8 + !...................................................... + call WrFileNR ( p%unOutFile2, ' (s) ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile2, InitOut%delim//InitOut%WriteOutputUntforPE(i) ) + end do ! i + write (p%unOutFile2,'()') + !frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules + !call WrNumAryFileNR ( p%unOutFile2, p%FreqList, frmt, errStat, errMsg ) + !if ( errStat >= AbortErrLev ) return + !write (p%unOutFile2,'()') + ENDIF + ! THIRD FILE + IF (InputFileData%NrOutFile .gt. 2) THEN + call GetNewUnit( p%unOutFile3, ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) then + p%unOutFile = -1 + return + end if + call OpenFOutFile ( p%unOutFile3, trim(InputFileData%AAOutFile(3)), ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) return + write (p%unOutFile3,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%Ver)) + write (p%unOutFile3,'(A)') '' + write( p%unOutFile3,'(A,I5,A,I5)' ) 'Number of observers :', p%NrObsLoc,'; Number of frequencies :', size(p%FreqList) + write (p%unOutFile3,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) + numOuts = size(InitOut%WriteOutputHdrSep) + !...................................................... + ! Write the names of the output parameters on one line: line 7 + !...................................................... + call WrFileNR ( p%unOutFile3, "1-LBL 2-TBLPres 3-TBLSuc 4-Sep 5-BLUNT 6-TIP 7-Inflow") + write (p%unOutFile3,'()') + call WrFileNR ( p%unOutFile3, ' Time ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile3, InitOut%delim//InitOut%WriteOutputHdrSep(i) ) + end do ! i + write (p%unOutFile3,'()') + !...................................................... + ! Write the units of the output parameters on one line: line 8 + !...................................................... + call WrFileNR ( p%unOutFile3, ' (s) ' ) + + do i=1,NumOuts + call WrFileNR ( p%unOutFile3, InitOut%delim//InitOut%WriteOutputUntSep(i) ) + end do ! i + write (p%unOutFile3,'()') + ENDIF + ! FOURTH FILE + IF (InputFileData%NrOutFile .gt. 3) THEN + call GetNewUnit( p%unOutFile4, ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) then + p%unOutFile = -1 + return + end if + call OpenFOutFile ( p%unOutFile4, trim(InputFileData%AAOutFile(4)), ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) return + write (p%unOutFile4,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%Ver)) + write (p%unOutFile4,'()') + write( p%unOutFile4,'(A,I5)' ) 'Number of observers :', p%NrObsLoc, '; Number of blades :', p%numBlades,' Number of nodes per blade:', p%NumBlNds + write (p%unOutFile4,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) + numOuts = size(InitOut%WriteOutputHdrNodes) + !...................................................... + ! Write the names of the output parameters on one line: line 7 + !...................................................... + write (p%unOutFile4,'()') + call WrFileNR ( p%unOutFile4, ' Time ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile4, InitOut%delim//InitOut%WriteOutputHdrNodes(i) ) + end do ! i + write (p%unOutFile4,'()') + !...................................................... + ! Write the units of the output parameters on one line: line 8 + !...................................................... + call WrFileNR ( p%unOutFile4, ' (s) ' ) + do i=1,NumOuts + call WrFileNR ( p%unOutFile4, InitOut%delim//InitOut%WriteOutputUntNodes(i) ) + end do ! i + write (p%unOutFile4,'()') + ENDIF +end subroutine AA_InitializeOutputFile +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine AA_WriteOutputLine(y, t, p, errStat, errMsg) + real(DbKi) , intent(in ) :: t ! simulation time (s) + type(AA_OutputType) , intent(in ) :: y + type(AA_ParameterType) , intent(in ) :: p + integer(IntKi) , intent(inout) :: errStat ! Status of error message + character(*) , intent(inout) :: errMsg ! Error message if ErrStat /= ErrID_None + ! Local variables. + character(200) :: frmt ! A string to hold a format specifier + character(15) :: tmpStr ! temporary string to print the time output as text + integer :: numOuts + errStat = ErrID_None + errMsg = '' + ! FIRST FILE + IF (p%NrOutFile .gt. 0) THEN + numOuts = size(y%WriteOutput) + frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules + ! time + write( tmpStr, '(F15.4)' ) t + call WrFileNR( p%unOutFile, tmpStr ) + call WrNumAryFileNR ( p%unOutFile, y%WriteOutput, frmt, errStat, errMsg ) + if ( errStat >= AbortErrLev ) return + ! write a new line (advance to the next line) + write (p%unOutFile,'()') + ENDIF + + !! SECOND FILE + IF (p%NrOutFile .gt. 1) THEN + numOuts = size(y%WriteOutputforPE) + frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules + ! time + write( tmpStr, '(F15.4)' ) t + call WrFileNR( p%unOutFile2, tmpStr ) + call WrNumAryFileNR ( p%unOutFile2, y%WriteOutputforPE, frmt, errStat, errMsg ) + if ( errStat >= AbortErrLev ) return + ! write a new line (advance to the next line) + write (p%unOutFile2,'()') + ENDIF + ! THIRD FILE + IF (p%NrOutFile .gt. 2) THEN + numOuts = size(y%WriteOutputSep) + frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules + ! time + write( tmpStr, '(F15.4)' ) t + call WrFileNR( p%unOutFile3, tmpStr ) + call WrNumAryFileNR ( p%unOutFile3, y%WriteOutputSep, frmt, errStat, errMsg ) + if ( errStat >= AbortErrLev ) return + ! write a new line (advance to the next line) + write (p%unOutFile3,'()') + ENDIF + ! Fourth FILE + IF (p%NrOutFile .gt. 3) THEN + numOuts = size(y%WriteOutputNode) + frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules + ! time + write( tmpStr, '(F15.4)' ) t + call WrFileNR( p%unOutFile4, tmpStr ) + call WrNumAryFileNR ( p%unOutFile4, y%WriteOutputNode, frmt, errStat, errMsg ) + if ( errStat >= AbortErrLev ) return + ! write a new line (advance to the next line) + write (p%unOutFile4,'()') + ENDIF +end subroutine AA_WriteOutputLine +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) + TYPE(AA_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AA_InputType), INTENT(IN ) :: u ! inputs + TYPE(AA_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(AA_OutputType), INTENT(INOUT) :: y ! outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + 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) :: j,k,counter,i,oi,III + ! start routine: + ErrStat = ErrID_None + ErrMsg = "" + + ! FOR THE FIRST OUTPUT FILE + IF (p%NrOutFile .gt. 0) THEN + y%WriteOutput(1:p%NrObsLoc)=y%DirectiviOutput + endif + + ! FOR THE SECOND OUTPUT FILE + IF (p%NrOutFile .gt. 1) THEN + counter=0 + DO K = 1,p%NrObsLoc + DO III = 1,size(p%FreqList) + counter=counter+1 + y%WriteOutputforPE(counter) = y%PtotalFreq(K,III) + END DO ! + END DO ! + ENDIF + + ! FOR THE THIRD OUTPUT FILE + IF (p%NrOutFile .gt. 2) THEN + counter=0 + do K = 1,p%NrObsLoc + do III = 1,size(p%FreqList) + do oi=1,size(y%OASPL_Mech,1) + counter=counter+1 + y%WriteOutputSep(counter) = y%SumSpecNoiseSep(oi,K,III) + enddo + enddo + enddo + ENDIF + + ! FOR THE FOURTH OUTPUT FILE + IF (p%NrOutFile .gt. 3) THEN + counter=0 + DO I = 1,p%numBlades + DO J = 1,p%NumBlNds + DO K = 1,p%NrObsLoc + counter=counter+1 + y%WriteOutputNode(counter) = y%OASPL(K,J,I) + END DO ! + END DO ! + ENDDO + ENDIF +END SUBROUTINE Calc_WriteOutput +!---------------------------------------------------------------------------------------------------------------------------------- +END MODULE AeroAcoustics_IO diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt new file mode 100644 index 0000000000..b5d1a865ee --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -0,0 +1,252 @@ +################################################################################################################################### +# Registry for AeroAcoustics module in the FAST Modularization Framework +# This Registry file is used to create AeroDyn_Types which contains data used in the AeroDyn module. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +# File last committed $Date: 2016-03-14 12:13:10 -0600 (Mon, 14 Mar 2016) $ +# (File) Revision #: $Rev: 201 $ +# URL: $HeadURL: https://windsvn.nrel.gov/WT_Perf/branches/v4.x/Source/dependencies/AeroDyn/AeroDyn_Registry.txt $ +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt +usefrom AirfoilInfo_Registry.txt +# +# ..... Input file data ........................................................................................................... +# This is data defined in the Input File for this module (or could otherwise be passed in) +# ..... Blade Input file data ..................................................................................................... +typedef AeroAcoustics/AA AA_BladePropsType IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - +typedef ^ AA_BladePropsType ReKi TEThick {:} - - "" - +typedef ^ AA_BladePropsType ReKi StallStart {:} - - "" - +typedef ^ AA_BladePropsType ReKi TEAngle {:} - - "" - +typedef ^ AA_BladePropsType ReKi AerCent {:} - - "" - +# +# ..... Initialization data ....................................................................................................... +# Define inputs that the initialization routine may need here: +typedef AeroAcoustics/AA InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - +typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" +typedef ^ InitInputType IntKi NumBlNds - - - "Number of blades on the turbine" +typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ InitInputType ReKi BlSpn {:}{:} - - "Span at blade node" m +typedef ^ InitInputType ReKi BlChord {:}{:} - - "Chord at blade node" m +typedef ^ InitInputType ReKi AirDens - - - "Air density" kg/m^3 +typedef ^ InitInputType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s +typedef ^ InitInputType ReKi SpdSound - - - "Speed of sound" m/s +typedef ^ InitInputType ReKi HubHeight - - - "Hub Height" m +typedef ^ InitInputType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - +typedef ^ InitInputType AFI_ParameterType AFInfo {:} - - "Airfoil information structure containing the aerodynamic center and airfoil shape coordinates" +# +# Define outputs from the initialization routine here: +typedef ^ InitOutputType CHARACTER(20) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(20) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(20) WriteOutputHdrforPE {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(20) WriteOutputUntforPE {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(25) WriteOutputHdrSep {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(25) WriteOutputUntSep {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(25) WriteOutputHdrNodes {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(25) WriteOutputUntNodes {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType character(1) delim - - - "column delimiter" "-" +typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 +# + +# ..... Primary Input file data ................................................................................................... +typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or "default"}" s +typedef ^ AA_InputFile IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE" - +typedef ^ AA_InputFile IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model}" - +typedef ^ AA_InputFile IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - +typedef ^ AA_InputFile IntKi ITRIP - - - "FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - +typedef ^ AA_InputFile IntKi ITURB - - - "FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - +typedef ^ AA_InputFile IntKi IInflow - - - "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - +typedef ^ AA_InputFile IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated" - +typedef ^ AA_InputFile IntKi TICalcMeth - - - "TICalcMeth" - +typedef ^ AA_InputFile IntKi NReListBL - - - "Number of values of ReListBL" - +typedef ^ AA_InputFile Logical aweightflag - - - "Integer a weighting call" - +typedef ^ AA_InputFile Logical ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - +typedef ^ AA_InputFile ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - +typedef ^ AA_InputFile IntKi AA_Bl_Prcntge - - - "see the AeroAcoustics input file for description " - +typedef ^ AA_InputFile IntKi NrObsLoc - - - "Number of observer locations " - +typedef ^ AA_InputFile ReKi ObsX {:} - - "Observer location in tower-base coordinate X horizontal" m +typedef ^ AA_InputFile ReKi ObsY {:} - - "Observer location in tower-base coordinate Y lateral" m +typedef ^ AA_InputFile ReKi ObsZ {:} - - "Observer location in tower-base coordinate Z vertical" m +typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - +typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - +typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {:} - - "AAoutfile for writing output files" - +typedef ^ AA_InputFile CHARACTER(1024) TICalcTabFile - - - "Name of the file containing the table for incident turbulence intensity" - +typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - +typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ AA_InputFile ReKi z0_AA - - - "Surface roughness" - +typedef ^ AA_InputFile ReKi ReListBL {:} - - "" +typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg +typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_DispThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_BLThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_BLThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_Cf {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi TI_Grid_In {:}{:} - - "" +typedef ^ AA_InputFile ReKi dz_turb_in - - - "" m +typedef ^ AA_InputFile ReKi dy_turb_in - - - "" m + +# ..... States .................................................................................................................... +# Define continuous (differentiable) states here: +# +typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - +# +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi MeanVrel {:}{:} - - "Vrel Cumu. Mean" - +typedef ^ DiscreteStateType ReKi VrelSq {:}{:} - - "Vrel Squared Store" - +typedef ^ DiscreteStateType ReKi TIVrel {:}{:} - - "Vrel St. deviat" - +typedef ^ DiscreteStateType ReKi VrelStore {:}{:}{:} - - "Vrel Store for fft - dissipation" - +typedef ^ DiscreteStateType ReKi TIVx {:}{:} - - "Vx St. deviat" - +typedef ^ DiscreteStateType ReKi MeanVxVyVz {:}{:} - - "Vrel Cumu. Mean" - +typedef ^ DiscreteStateType ReKi VxSq {:}{:} - - "Vxl Squared Store" - +typedef ^ DiscreteStateType ReKi allregcounter {:}{:} - - "" - +typedef ^ DiscreteStateType ReKi VxSqRegion {:}{:} - - "" - +typedef ^ DiscreteStateType ReKi RegVxStor {:}{:}{:} - - "VxVyVz Store for fft or TI - dissipation" - +typedef ^ DiscreteStateType ReKi RegionTIDelete {:}{:} - - "" - +# +# Define constraint states here: +typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have states" - +# +# Define "other" states here: +typedef ^ OtherStateType SiKi DummyOtherState - - - "Remove this variable if you have states" - +# +# Define misc/optimization variables (any data that are not considered actual states) here: +##typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s +typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - +typedef ^ MiscVarType ReKi ChordAngleTE {:}{:}{:} - - "C" - +typedef ^ MiscVarType ReKi SpanAngleTE {:}{:}{:} - - "C" - +typedef ^ MiscVarType ReKi ChordAngleLE {:}{:}{:} - - "C" - +typedef ^ MiscVarType ReKi SpanAngleLE {:}{:}{:} - - "C" - +typedef ^ MiscVarType ReKi rTEtoObserve {:}{:}{:} - - "C" - +typedef ^ MiscVarType ReKi rLEtoObserve {:}{:}{:} - - "C" - +typedef ^ MiscVarType ReKi LE_Location {:}{:}{:} - - "Height of Leading Edge for calculation of TI and Scales if needed" - +typedef ^ MiscVarType ReKi RotSpeedAoA - - - "C" - +typedef ^ MiscVarType ReKi SPLLBL {:} - - "C" - +typedef ^ MiscVarType ReKi SPLP {:} - - "C" - +typedef ^ MiscVarType ReKi SPLS {:} - - "C" - +typedef ^ MiscVarType ReKi SPLALPH {:} - - "C" - +typedef ^ MiscVarType ReKi SPLTBL {:} - - "C" - +typedef ^ MiscVarType ReKi SPLTIP {:} - - "C" - +typedef ^ MiscVarType ReKi SPLTI {:} - - "C" - +typedef ^ MiscVarType ReKi SPLTIGui {:} - - "C" - +typedef ^ MiscVarType ReKi SPLBLUNT {:} - - "C" - +typedef ^ MiscVarType ReKi CfVar {:} - - "Output Skin friction coef Pressure Side" - +typedef ^ MiscVarType ReKi d99Var {:} - - "BL Output " - +typedef ^ MiscVarType ReKi dStarVar {:} - - "BL Output " - +typedef ^ MiscVarType ReKi EdgeVelVar {:} - - "BL Output " - +typedef ^ MiscVarType IntKi speccou - - - "Secptrum counter every XX seconds new spectrum" - +typedef ^ MiscVarType IntKi filesopen - - - "check if file is open" - +# ..... Parameters ................................................................................................................ +# Define parameters here: +# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds +typedef ^ ParameterType IntKi IBLUNT - - - "Bluntness noise model" - +typedef ^ ParameterType IntKi ILAM - - - "LBL noise model " - +typedef ^ ParameterType IntKi ITIP - - - "Tip noise model" - +typedef ^ ParameterType IntKi ITRIP - - - "Trip boundary layer" - +typedef ^ ParameterType IntKi ITURB - - - "Tblte noise model" - +typedef ^ ParameterType IntKi IInflow - - - "Turbulent inflow noise model" - +typedef ^ ParameterType IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated" - +typedef ^ ParameterType IntKi TICalcMeth - - - "" - +typedef ^ ParameterType Logical ROUND - - - "Logical indicating rounded tip" - +typedef ^ ParameterType ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - +typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - +typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - +typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 +typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s +typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s +typedef ^ ParameterType ReKi HubHeight - - - "Hub height" m +typedef ^ ParameterType ReKi toptip - - - "Top Tip Height = Hub height plus radius" m +typedef ^ ParameterType ReKi bottip - - - "Bottom Tip Height = Hub height minus radius" m +typedef ^ ParameterType ReKi rotorregionlimitsVert {:} - - "" +typedef ^ ParameterType ReKi rotorregionlimitsHorz {:} - - "" +typedef ^ ParameterType ReKi rotorregionlimitsalph {:} - - "" +typedef ^ ParameterType ReKi rotorregionlimitsrad {:} - - "" +typedef ^ ParameterType IntKi NrObsLoc - - - "Number of observer locations " - +typedef ^ ParameterType Logical aweightflag - - - " " - +typedef ^ ParameterType Logical TxtFileOutput - - - " " - +typedef ^ ParameterType DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ ParameterType ReKi ObsX {:} - - "Observer location in tower-base coordinate X horizontal" m +typedef ^ ParameterType ReKi ObsY {:} - - "Observer location in tower-base coordinate Y lateral" m +typedef ^ ParameterType ReKi ObsZ {:} - - "Observer location in tower-base coordinate Z vertical" m +typedef ^ ParameterType ReKi FreqList {:} - - "List of Acoustic Frequencies to Calculate" Hz +typedef ^ ParameterType ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB +typedef ^ ParameterType ReKi Fsample - - - "Sampling Frequency 1/delta(t) - 1/(simulation time step)" Hz +typedef ^ ParameterType IntKi total_sample - - - "Total FFT Sample amount for dissipation calculation" - +typedef ^ ParameterType IntKi total_sampleTI - - - "Total FFT Sample amount for dissipation calculation" - +typedef ^ ParameterType IntKi AA_Bl_Prcntge - - - "The Percentage of the Blade which the noise is calculated" % +typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - +typedef ^ ParameterType ReKi z0_aa - - - "Surface roughness" m +typedef ^ ParameterType ReKi dz_turb_in - - - "" m +typedef ^ ParameterType ReKi dy_turb_in - - - "" m +typedef ^ ParameterType ReKi TI_Grid_In {:}{:} - - "" +typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - + +# parameters for output +typedef ^ ParameterType character(20) outFmt - - - "Format specifier" "-" +typedef ^ ParameterType IntKi NrOutFile - - - "Nr of output files" - +typedef ^ ParameterType character(1) delim - - - "column delimiter" "-" +typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOutsForPE - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOutsForSep - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOutsForNodes - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi unOutFile - - - "unit number for writing output file" "-" +typedef ^ ParameterType IntKi unOutFile2 - - - "unit number for writing output file" "-" +typedef ^ ParameterType IntKi unOutFile3 - - - "unit number for writing output file" "-" +typedef ^ ParameterType IntKi unOutFile4 - - - "unit number for writing output file" "-" +typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType ReKi StallStart {:}{:} - - "ation" - +typedef ^ ParameterType ReKi TEThick {:}{:} - - "ation" - +typedef ^ ParameterType ReKi TEAngle {:}{:} - - "ation" - +typedef ^ ParameterType ReKi AerCent {:}{:}{:} - - "ation" - +typedef ^ ParameterType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - +typedef ^ ParameterType AFI_ParameterType AFInfo {:} - - "Airfoil information structure containing the aerodynamic center and airfoil shape coordinates" +typedef ^ ParameterType ReKi AFLECo {:}{:}{:} - - "Dimensionalized " +typedef ^ ParameterType ReKi AFTECo {:}{:}{:} - - +typedef ^ ParameterType ReKi BlSpn {:}{:} - - "Span at blade node" m +typedef ^ ParameterType ReKi BlChord {:}{:} - - "Chord at blade node" m +typedef ^ ParameterType ReKi ReListBL {:} - - "BL list of Reynolds" - +typedef ^ ParameterType ReKi AOAListBL {:} - - "BL list of Angle Of Attack " deg +typedef ^ ParameterType ReKi dStarAll1 {:}{:}{:} - - "Output Disp Thickness Suction Side" m +typedef ^ ParameterType ReKi dStarAll2 {:}{:}{:} - - "Output Disp Thickness Pressure Side" m +typedef ^ ParameterType ReKi d99All1 {:}{:}{:} - - "Output B.L. Thickness Suction Side" m +typedef ^ ParameterType ReKi d99All2 {:}{:}{:} - - "Output B.L. Thickness Pressure Side" m +typedef ^ ParameterType ReKi CfAll1 {:}{:}{:} - - "Output Skin friction coef Suction Side" - +typedef ^ ParameterType ReKi CfAll2 {:}{:}{:} - - "Output Skin friction coef Pressure Side" - +typedef ^ ParameterType ReKi EdgeVelRat1 {:}{:}{:} - - "Output Edge Velocity Ratio Suction" - +typedef ^ ParameterType ReKi EdgeVelRat2 {:}{:}{:} - - "Output Edge Velocity Ratio Pressure Side" - +typedef ^ ParameterType ReKi AFThickGuida {:}{:} - - "1 and 10 percent thickness t/c used for Simplified Guidati" +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: + +typedef ^ InputType ReKi RotGtoL {:}{:}{:}{:} - - "3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system" - +typedef ^ InputType ReKi AeroCent_G {:}{:}{:} - - "location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade" - +typedef ^ InputType ReKi Vrel {:}{:} - - "Vrel" - +typedef ^ InputType ReKi AoANoise {:}{:} - - "Angle of attack" - +typedef ^ InputType ReKi Inflow {:}{:}{:} - - "atmospheric undisturbed flow on blade" + +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +typedef ^ OutputType ReKi SumSpecNoise {:}{:}{:} - - "Spectra of summed noise level of each blade and blade nodes for each receiver and frequency" SPL +typedef ^ OutputType ReKi SumSpecNoiseSep {:}{:}{:} - - "Spectra of summed noise level of all blades and blade nodes for each receiver and frequency" SPL +typedef ^ OutputType ReKi OASPL {:}{:}{:} - - "summed noise level for each blade and blade nodes and receiver " SPL +typedef ^ OutputType ReKi OASPL_Mech {:}{:}{:}{:} - - "5 different mechanism noise level for each blade and blade nodes and receiver " SPL +typedef ^ OutputType ReKi DirectiviOutput {:} - - " " SPL +typedef ^ OutputType ReKi OutLECoords {:}{:}{:}{:} - - " " m +typedef ^ OutputType ReKi PtotalFreq {:}{:} - - "SPL for each observer and frequency" + +# Define outputs that are not on this mesh here: +typedef ^ OutputType ReKi WriteOutputForPE {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputSep {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputNode {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/modules/aerodyn/src/AeroAcoustics_TNO.f90 b/modules/aerodyn/src/AeroAcoustics_TNO.f90 new file mode 100644 index 0000000000..a2d9ab2b8c --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_TNO.f90 @@ -0,0 +1,198 @@ +MODULE TNO + + + use NWTC_Library ! ReKi, DBKi, R8Ki + use NWTC_SLATEC ! slatec_qk61 -- which is all that is in that library right now. + + implicit none + PUBLIC :: SPL_integrate + + INTEGER, PARAMETER :: TNOKi = ReKi + + REAL (TNOKi), PARAMETER :: Cnuk = 5.5 + REAL (TNOKi), PARAMETER :: kappa = 0.41 + REAL (TNOKi), PARAMETER :: Cmu = 0.09 +! INTEGER(IntKi),PARAMETER :: limit = 5000 + + !TNO variables + REAL (TNOKi) :: Omega_TNO ! NOTE: not a constant and used by function f_int1 and f_int2 + + !atmosphere variables + REAL (TNOKi) :: nu + REAL (TNOKi) :: co + REAL (TNOKi) :: rho + + ! Wavenumber variables + REAL (TNOKi) :: k + REAL (TNOKi) :: k1 + REAL (TNOKi) :: k3 + + ! Blade params + REAL (TNOKi) :: d99(2) + REAL (TNOKi) :: Cf(2) + REAL (TNOKi) :: edgevel(2) + + ! Airfoil + REAL(TNOKi) :: Mach_TNO + LOGICAL :: ISSUCTION_TNO + + +contains + +!> Solve the spl generated at this location and frequency +function SPL_integrate(Omega,limits,ISSUCTION, & + Mach,SpdSound,AirDens,KinVisc, & + Cfall,d99all,EdgeVelAll) result(integrand) + real(ReKi), intent(in ) :: Omega !< frequency + real(ReKi), intent(in ) :: limits(2) !< integration limits + logical, intent(in ) :: ISSUCTION !< Is it the suction edge + real(ReKi), intent(in ) :: Mach !< Mach number + real(ReKi), intent(in ) :: SpdSound !< Speed of sound + real(ReKi), intent(in ) :: AirDens !< Air density + real(ReKi), intent(in ) :: KinVisc !< Kinetic air viscosity + real(ReKi), intent(in ) :: Cfall(2) !< Skin friction coefficient (-) + real(ReKi), intent(in ) :: d99all(2) !< + real(ReKi), intent(in ) :: EdgeVelAll(2) !< + real(ReKi) :: integrand !< integrand result + + real(TNOKi) :: answer !< value returned from qk61, NOTE the typing + + ! local variables that are ignored + real(TNOKi) :: abserr,resabs,resasc !< accuracy estimates and residuals. Currently ignored + + ! Set module values from input + ISSUCTION_TNO = ISSUCTION + Omega_TNO = real(Omega,TNOKi) + ! Mach number of segment + Mach_TNO = real(Mach,TNOKi) + ! Atmospheric values + co = real(SpdSound, TNOKi) + rho = real(AirDens, TNOKi) + nu = real(KinVisc, TNOKi) + ! Blade node values + Cf = real(Cfall, TNOKi) + d99 = real(d99all, TNOKi) + edgevel = real(ABS(EdgeVelAll),TNOKi) + + call slatec_qk61(f_int2,limits(1),limits(2),answer,abserr,resabs,resasc) + integrand = real( answer, ReKi ) + +end function SPL_integrate + + + +FUNCTION f_int1(x2) + REAL(TNOKi):: alpha + REAL(TNOKi):: alpha_gauss + REAL(TNOKi):: Cfin + REAL(TNOKi):: delta + REAL(TNOKi):: dudx + REAL(TNOKi):: ke + REAL(TNOKi):: k1_hat + REAL(TNOKi):: k3_hat + REAL(TNOKi):: kT + REAL(TNOKi):: L + REAL(TNOKi):: Nut + REAL(TNOKi):: phi22 + REAL(TNOKi):: phim + REAL(TNOKi):: ums + REAL(TNOKi):: u_star + REAL(TNOKi):: U + REAL(TNOKi):: Uc + REAL(TNOKi):: Uo + REAL(TNOKi):: W + REAL(TNOKi), intent(in) :: x2 + REAL(TNOKi):: f_int1 + + ! changed and being multiplied with edge velocity taken from xfoil output + ! Uo=Mach_TNO*co ISSUCTION_TNO use edgevel(1) + + !constants from xfoil + if (ISSUCTION_TNO) then + alpha = 0.45 ! = 0.3 pressure, = 0.45 suction + Cfin = Cf(1) + delta = d99(1) + Uo=Mach_TNO*co*edgevel(1) + else + alpha = 0.30 + Cfin = Cf(2) + delta = d99(2) + Uo=Mach_TNO*co*edgevel(2) + endif + if (Cfin .le. 0.) then + write(*,*) 'Cf is less than zero, Cf = ',Cfin + stop + endif + u_star = Uo*sqrt(Cfin/2.) + + L = 0.085*delta*tanh(kappa*x2/(0.085*delta)) + + if (x2 .gt. delta)then + U = Uo + dudx = 0. + f_int1 = 0. + RETURN + else + W = 1.-cos(pi*x2/delta); + U = u_star*(1./kappa*log(u_star*x2/nu) +Cnuk+ (Uo/u_star-1./kappa*log(u_star*delta/nu)-Cnuk)*0.5*W) + dudx = u_star*(1./(kappa*x2)+(Uo/u_star-1./kappa*log(u_star*delta/nu)-Cnuk)* & + 0.5*(pi/delta)*sin(pi*x2/delta)) + endif + + ke=sqrt(pi)/L*0.4213560764 !gamma(5./6.)/gamma(1./3.) + k1_hat = k1/ke + k3_hat = k3/ke + + Nut = (L*kappa)**2.*abs(dudx) + kT = sqrt((Nut*dudx)**2./Cmu) + ums = alpha*kT + + Uc = 0.7*U + alpha_gauss = 0.05*Uc/L + + phim = 1./(alpha_gauss*sqrt(pi))*exp(-((Omega_TNO-Uc*k1)/alpha_gauss)**2.) + phi22 = 4./9./pi*1/ke**2.*(k1_hat**2.+k3_hat**2.)/(1.+k1_hat**2.+k3_hat**2.)**(7./3.) + f_int1 = L*ums*(dudx)**2*phi22*phim*exp(-2*abs(k)*x2) + + RETURN +END FUNCTION f_int1 + + +FUNCTION f_int2(k1) ! changed name from 'int2' to avoid conflicts with intrinsic of same name + REAL (TNOKi), intent(in) :: k1 + REAL (TNOKi) :: f_int2 + f_int2 = Omega_TNO/co/k1*Pressure(k1) + RETURN +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 + + ! Set variables used in f_int1 + k1 = k1_in + + a = 0.0_TNOKi !1e-4*d99(1) + IF (ISSUCTION_TNO)THEN + b = d99(1) + ELSE + b = d99(2) + ENDIF + + k3 = 0. + k= sqrt(k1**2+k3**2) + + CALL slatec_qk61(f_int1,a,b,answer,abserr,resabs,resasc) + + Pressure = 4.*rho**2*k1**2./(k1**2.+k3**2.)*answer + + RETURN +END FUNCTION Pressure + + +END MODULE TNO diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 new file mode 100644 index 0000000000..9ed3b64f53 --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -0,0 +1,10536 @@ +!STARTOFREGISTRYGENERATEDFILE 'AeroAcoustics_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! AeroAcoustics_Types +!................................................................................................................................. +! This file is part of AeroAcoustics. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in AeroAcoustics. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE AeroAcoustics_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE AirfoilInfo_Types +USE NWTC_Library +IMPLICIT NONE +! ========= AA_BladePropsType ======= + TYPE, PUBLIC :: AA_BladePropsType + INTEGER(IntKi) :: NumBlNds !< Number of blade nodes used in the analysis [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TEThick !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StallStart !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TEAngle !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AerCent !< [-] + END TYPE AA_BladePropsType +! ======================= +! ========= AA_InitInputType ======= + TYPE, PUBLIC :: AA_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds !< Number of blades on the turbine [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] + REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight !< Hub Height [m] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] + TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] + END TYPE AA_InitInputType +! ======================= +! ========= AA_InitOutputType ======= + TYPE, PUBLIC :: AA_InitOutputType + CHARACTER(20) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] + CHARACTER(20) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + CHARACTER(20) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdrforPE !< Names of the output-to-file channels [-] + CHARACTER(20) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntforPE !< Units of the output-to-file channels [-] + CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdrSep !< Names of the output-to-file channels [-] + CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntSep !< Units of the output-to-file channels [-] + CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdrNodes !< Names of the output-to-file channels [-] + CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntNodes !< Units of the output-to-file channels [-] + character(1) :: delim !< column delimiter [-] + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + REAL(ReKi) :: AirDens !< Air density [kg/m^3] + END TYPE AA_InitOutputType +! ======================= +! ========= AA_InputFile ======= + TYPE, PUBLIC :: AA_InputFile + REAL(DbKi) :: DT_AA !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: IBLUNT !< FLAG TO COMPUTE BLUNTNESS NOISE [-] + INTEGER(IntKi) :: ILAM !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] + INTEGER(IntKi) :: ITIP !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITRIP !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITURB !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: IInflow !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth !< TICalcMeth [-] + INTEGER(IntKi) :: NReListBL !< Number of values of ReListBL [-] + LOGICAL :: aweightflag !< Integer a weighting call [-] + LOGICAL :: ROUND !< LOGICAL INDICATING ROUNDED TIP [-] + REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: AA_Bl_Prcntge !< see the AeroAcoustics input file for description [-] + INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] + TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] + INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] + CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] + CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] + REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] + REAL(ReKi) :: z0_AA !< Surface roughness [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_DispThick !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_BLThick !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_BLThick !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_Cf !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_Cf !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_EdgeVelRat !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] + REAL(ReKi) :: dz_turb_in !< [m] + REAL(ReKi) :: dy_turb_in !< [m] + END TYPE AA_InputFile +! ======================= +! ========= AA_ContinuousStateType ======= + TYPE, PUBLIC :: AA_ContinuousStateType + REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + END TYPE AA_ContinuousStateType +! ======================= +! ========= AA_DiscreteStateType ======= + TYPE, PUBLIC :: AA_DiscreteStateType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeanVrel !< Vrel Cumu. Mean [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VrelSq !< Vrel Squared Store [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIVrel !< Vrel St. deviat [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: VrelStore !< Vrel Store for fft - dissipation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIVx !< Vx St. deviat [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeanVxVyVz !< Vrel Cumu. Mean [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VxSq !< Vxl Squared Store [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: allregcounter !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VxSqRegion !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RegVxStor !< VxVyVz Store for fft or TI - dissipation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: RegionTIDelete !< [-] + END TYPE AA_DiscreteStateType +! ======================= +! ========= AA_ConstraintStateType ======= + TYPE, PUBLIC :: AA_ConstraintStateType + REAL(SiKi) :: DummyConstrState !< Remove this variable if you have states [-] + END TYPE AA_ConstraintStateType +! ======================= +! ========= AA_OtherStateType ======= + TYPE, PUBLIC :: AA_OtherStateType + REAL(SiKi) :: DummyOtherState !< Remove this variable if you have states [-] + END TYPE AA_OtherStateType +! ======================= +! ========= AA_MiscVarType ======= + TYPE, PUBLIC :: AA_MiscVarType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: ChordAngleTE !< C [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SpanAngleTE !< C [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: ChordAngleLE !< C [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SpanAngleLE !< C [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rTEtoObserve !< C [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rLEtoObserve !< C [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LE_Location !< Height of Leading Edge for calculation of TI and Scales if needed [-] + REAL(ReKi) :: RotSpeedAoA !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLLBL !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLP !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLS !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLALPH !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTBL !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTIP !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTI !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTIGui !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLBLUNT !< C [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CfVar !< Output Skin friction coef Pressure Side [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d99Var !< BL Output [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dStarVar !< BL Output [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgeVelVar !< BL Output [-] + INTEGER(IntKi) :: speccou !< Secptrum counter every XX seconds new spectrum [-] + INTEGER(IntKi) :: filesopen !< check if file is open [-] + END TYPE AA_MiscVarType +! ======================= +! ========= AA_ParameterType ======= + TYPE, PUBLIC :: AA_ParameterType + REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + INTEGER(IntKi) :: IBLUNT !< Bluntness noise model [-] + INTEGER(IntKi) :: ILAM !< LBL noise model [-] + INTEGER(IntKi) :: ITIP !< Tip noise model [-] + INTEGER(IntKi) :: ITRIP !< Trip boundary layer [-] + INTEGER(IntKi) :: ITURB !< Tblte noise model [-] + INTEGER(IntKi) :: IInflow !< Turbulent inflow noise model [-] + INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth !< [-] + LOGICAL :: ROUND !< Logical indicating rounded tip [-] + REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] + REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight !< Hub height [m] + REAL(ReKi) :: toptip !< Top Tip Height = Hub height plus radius [m] + REAL(ReKi) :: bottip !< Bottom Tip Height = Hub height minus radius [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsVert !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsHorz !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsalph !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsrad !< [-] + INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] + LOGICAL :: aweightflag !< [-] + LOGICAL :: TxtFileOutput !< [-] + REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Acoustic Frequencies to Calculate [Hz] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Aweight !< List of Acoustic Frequencies a weighting [dB] + REAL(ReKi) :: Fsample !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] + INTEGER(IntKi) :: total_sample !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: total_sampleTI !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: AA_Bl_Prcntge !< The Percentage of the Blade which the noise is calculated [%] + INTEGER(IntKi) :: startnode !< Corersponding node to the noise calculation percentage of the blade [-] + REAL(ReKi) :: z0_aa !< Surface roughness [m] + REAL(ReKi) :: dz_turb_in !< [m] + REAL(ReKi) :: dy_turb_in !< [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] + CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] + character(20) :: outFmt !< Format specifier [-] + INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + character(1) :: delim !< column delimiter [-] + INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForPE !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForSep !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForNodes !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: unOutFile !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile2 !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile3 !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile4 !< unit number for writing output file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StallStart !< ation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEThick !< ation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEAngle !< ation [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AerCent !< ation [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] + TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFLECo !< Dimensionalized [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFTECo + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< BL list of Reynolds [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AOAListBL !< BL list of Angle Of Attack [deg] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: dStarAll1 !< Output Disp Thickness Suction Side [m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: dStarAll2 !< Output Disp Thickness Pressure Side [m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: d99All1 !< Output B.L. Thickness Suction Side [m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: d99All2 !< Output B.L. Thickness Pressure Side [m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CfAll1 !< Output Skin friction coef Suction Side [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CfAll2 !< Output Skin friction coef Pressure Side [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: EdgeVelRat1 !< Output Edge Velocity Ratio Suction [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: EdgeVelRat2 !< Output Edge Velocity Ratio Pressure Side [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFThickGuida !< 1 and 10 percent thickness t/c used for Simplified Guidati [-] + END TYPE AA_ParameterType +! ======================= +! ========= AA_InputType ======= + TYPE, PUBLIC :: AA_InputType + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: RotGtoL !< 3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AeroCent_G !< location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vrel !< Vrel [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AoANoise !< Angle of attack [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Inflow !< atmospheric undisturbed flow on blade [-] + END TYPE AA_InputType +! ======================= +! ========= AA_OutputType ======= + TYPE, PUBLIC :: AA_OutputType + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SumSpecNoise !< Spectra of summed noise level of each blade and blade nodes for each receiver and frequency [SPL] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SumSpecNoiseSep !< Spectra of summed noise level of all blades and blade nodes for each receiver and frequency [SPL] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: OASPL !< summed noise level for each blade and blade nodes and receiver [SPL] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: OASPL_Mech !< 5 different mechanism noise level for each blade and blade nodes and receiver [SPL] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DirectiviOutput !< [SPL] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: OutLECoords !< [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtotalFreq !< SPL for each observer and frequency [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputForPE !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputSep !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputNode !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + END TYPE AA_OutputType +! ======================= +CONTAINS + SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData + TYPE(AA_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyBladePropsType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds +IF (ALLOCATED(SrcBladePropsTypeData%TEThick)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%TEThick,1) + i1_u = UBOUND(SrcBladePropsTypeData%TEThick,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%TEThick)) THEN + ALLOCATE(DstBladePropsTypeData%TEThick(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%TEThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%StallStart)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%StallStart,1) + i1_u = UBOUND(SrcBladePropsTypeData%StallStart,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%StallStart)) THEN + ALLOCATE(DstBladePropsTypeData%StallStart(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%StallStart.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%StallStart = SrcBladePropsTypeData%StallStart +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%TEAngle)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%TEAngle,1) + i1_u = UBOUND(SrcBladePropsTypeData%TEAngle,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%TEAngle)) THEN + ALLOCATE(DstBladePropsTypeData%TEAngle(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%TEAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle +ENDIF +IF (ALLOCATED(SrcBladePropsTypeData%AerCent)) THEN + i1_l = LBOUND(SrcBladePropsTypeData%AerCent,1) + i1_u = UBOUND(SrcBladePropsTypeData%AerCent,1) + IF (.NOT. ALLOCATED(DstBladePropsTypeData%AerCent)) THEN + ALLOCATE(DstBladePropsTypeData%AerCent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%AerCent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladePropsTypeData%AerCent = SrcBladePropsTypeData%AerCent +ENDIF + END SUBROUTINE AA_CopyBladePropsType + + SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) + TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyBladePropsType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(BladePropsTypeData%TEThick)) THEN + DEALLOCATE(BladePropsTypeData%TEThick) +ENDIF +IF (ALLOCATED(BladePropsTypeData%StallStart)) THEN + DEALLOCATE(BladePropsTypeData%StallStart) +ENDIF +IF (ALLOCATED(BladePropsTypeData%TEAngle)) THEN + DEALLOCATE(BladePropsTypeData%TEAngle) +ENDIF +IF (ALLOCATED(BladePropsTypeData%AerCent)) THEN + DEALLOCATE(BladePropsTypeData%AerCent) +ENDIF + END SUBROUTINE AA_DestroyBladePropsType + + SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_BladePropsType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackBladePropsType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! NumBlNds + Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no + IF ( ALLOCATED(InData%TEThick) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TEThick upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick + END IF + Int_BufSz = Int_BufSz + 1 ! StallStart allocated yes/no + IF ( ALLOCATED(InData%StallStart) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! StallStart upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%StallStart) ! StallStart + END IF + Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no + IF ( ALLOCATED(InData%TEAngle) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TEAngle upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle + END IF + Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no + IF ( ALLOCATED(InData%AerCent) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AerCent upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TEThick,1), UBOUND(InData%TEThick,1) + ReKiBuf(Re_Xferred) = InData%TEThick(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%StallStart) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%StallStart,1), UBOUND(InData%StallStart,1) + ReKiBuf(Re_Xferred) = InData%StallStart(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TEAngle,1), UBOUND(InData%TEAngle,1) + ReKiBuf(Re_Xferred) = InData%TEAngle(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AerCent,1), UBOUND(InData%AerCent,1) + ReKiBuf(Re_Xferred) = InData%AerCent(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AA_PackBladePropsType + + SUBROUTINE AA_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_BladePropsType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackBladePropsType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TEThick)) DEALLOCATE(OutData%TEThick) + ALLOCATE(OutData%TEThick(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TEThick,1), UBOUND(OutData%TEThick,1) + OutData%TEThick(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StallStart not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StallStart)) DEALLOCATE(OutData%StallStart) + ALLOCATE(OutData%StallStart(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%StallStart,1), UBOUND(OutData%StallStart,1) + OutData%StallStart(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TEAngle)) DEALLOCATE(OutData%TEAngle) + ALLOCATE(OutData%TEAngle(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TEAngle,1), UBOUND(OutData%TEAngle,1) + OutData%TEAngle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AerCent)) DEALLOCATE(OutData%AerCent) + ALLOCATE(OutData%AerCent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AerCent,1), UBOUND(OutData%AerCent,1) + OutData%AerCent(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AA_UnPackBladePropsType + + SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(AA_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds + DstInitInputData%RootName = SrcInitInputData%RootName +IF (ALLOCATED(SrcInitInputData%BlSpn)) THEN + i1_l = LBOUND(SrcInitInputData%BlSpn,1) + i1_u = UBOUND(SrcInitInputData%BlSpn,1) + i2_l = LBOUND(SrcInitInputData%BlSpn,2) + i2_u = UBOUND(SrcInitInputData%BlSpn,2) + IF (.NOT. ALLOCATED(DstInitInputData%BlSpn)) THEN + ALLOCATE(DstInitInputData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BlSpn = SrcInitInputData%BlSpn +ENDIF +IF (ALLOCATED(SrcInitInputData%BlChord)) THEN + i1_l = LBOUND(SrcInitInputData%BlChord,1) + i1_u = UBOUND(SrcInitInputData%BlChord,1) + i2_l = LBOUND(SrcInitInputData%BlChord,2) + i2_u = UBOUND(SrcInitInputData%BlChord,2) + IF (.NOT. ALLOCATED(DstInitInputData%BlChord)) THEN + ALLOCATE(DstInitInputData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BlChord = SrcInitInputData%BlChord +ENDIF + DstInitInputData%AirDens = SrcInitInputData%AirDens + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%SpdSound = SrcInitInputData%SpdSound + DstInitInputData%HubHeight = SrcInitInputData%HubHeight +IF (ALLOCATED(SrcInitInputData%BlAFID)) THEN + i1_l = LBOUND(SrcInitInputData%BlAFID,1) + i1_u = UBOUND(SrcInitInputData%BlAFID,1) + i2_l = LBOUND(SrcInitInputData%BlAFID,2) + i2_u = UBOUND(SrcInitInputData%BlAFID,2) + IF (.NOT. ALLOCATED(DstInitInputData%BlAFID)) THEN + ALLOCATE(DstInitInputData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BlAFID = SrcInitInputData%BlAFID +ENDIF +IF (ALLOCATED(SrcInitInputData%AFInfo)) THEN + i1_l = LBOUND(SrcInitInputData%AFInfo,1) + i1_u = UBOUND(SrcInitInputData%AFInfo,1) + IF (.NOT. ALLOCATED(DstInitInputData%AFInfo)) THEN + ALLOCATE(DstInitInputData%AFInfo(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitInputData%AFInfo,1), UBOUND(SrcInitInputData%AFInfo,1) + CALL AFI_CopyParam( SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE AA_CopyInitInput + + SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(AA_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitInputData%BlSpn)) THEN + DEALLOCATE(InitInputData%BlSpn) +ENDIF +IF (ALLOCATED(InitInputData%BlChord)) THEN + DEALLOCATE(InitInputData%BlChord) +ENDIF +IF (ALLOCATED(InitInputData%BlAFID)) THEN + DEALLOCATE(InitInputData%BlAFID) +ENDIF +IF (ALLOCATED(InitInputData%AFInfo)) THEN +DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) + CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InitInputData%AFInfo) +ENDIF + END SUBROUTINE AA_DestroyInitInput + + SUBROUTINE AA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile + Int_BufSz = Int_BufSz + 1 ! NumBlades + Int_BufSz = Int_BufSz + 1 ! NumBlNds + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no + IF ( ALLOCATED(InData%BlSpn) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn + END IF + Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no + IF ( ALLOCATED(InData%BlChord) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord + END IF + Re_BufSz = Re_BufSz + 1 ! AirDens + Re_BufSz = Re_BufSz + 1 ! KinVisc + Re_BufSz = Re_BufSz + 1 ! SpdSound + Re_BufSz = Re_BufSz + 1 ! HubHeight + Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no + IF ( ALLOCATED(InData%BlAFID) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID + END IF + Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no + IF ( ALLOCATED(InData%AFInfo) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) + Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype + CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AFInfo + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AFInfo + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AFInfo + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) + DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) + ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) + DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) + ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHeight + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) + DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) + IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AFInfo) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFInfo,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) + CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + END SUBROUTINE AA_PackInitInput + + SUBROUTINE AA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlSpn)) DEALLOCATE(OutData%BlSpn) + ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) + DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) + OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlChord)) DEALLOCATE(OutData%BlChord) + ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) + DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) + OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlAFID)) DEALLOCATE(OutData%BlAFID) + ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) + DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) + OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFInfo)) DEALLOCATE(OutData%AFInfo) + ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + END SUBROUTINE AA_UnPackInitInput + + SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(AA_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrforPE)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrforPE)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUntforPE)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUntforPE,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUntforPE,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntforPE)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrSep)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrSep,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrSep,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrSep)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUntSep)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUntSep,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUntSep,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntSep)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrNodes)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrNodes)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUntNodes)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUntNodes,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUntNodes,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntNodes)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes +ENDIF + DstInitOutputData%delim = SrcInitOutputData%delim + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInitOutputData%AirDens = SrcInitOutputData%AirDens + END SUBROUTINE AA_CopyInitOutput + + SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(AA_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputHdrforPE)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdrforPE) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUntforPE)) THEN + DEALLOCATE(InitOutputData%WriteOutputUntforPE) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputHdrSep)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdrSep) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUntSep)) THEN + DEALLOCATE(InitOutputData%WriteOutputUntSep) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputHdrNodes)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdrNodes) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUntNodes)) THEN + DEALLOCATE(InitOutputData%WriteOutputUntNodes) +ENDIF + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) + END SUBROUTINE AA_DestroyInitOutput + + SUBROUTINE AA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrforPE allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdrforPE) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrforPE upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrforPE)*LEN(InData%WriteOutputHdrforPE) ! WriteOutputHdrforPE + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUntforPE allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUntforPE) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntforPE upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntforPE)*LEN(InData%WriteOutputUntforPE) ! WriteOutputUntforPE + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrSep allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdrSep) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrSep upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrSep)*LEN(InData%WriteOutputHdrSep) ! WriteOutputHdrSep + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUntSep allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUntSep) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntSep upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntSep)*LEN(InData%WriteOutputUntSep) ! WriteOutputUntSep + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrNodes allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdrNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrNodes)*LEN(InData%WriteOutputHdrNodes) ! WriteOutputHdrNodes + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUntNodes allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUntNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntNodes)*LEN(InData%WriteOutputUntNodes) ! WriteOutputUntNodes + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Re_BufSz = Re_BufSz + 1 ! AirDens + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputHdrforPE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrforPE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrforPE,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdrforPE,1), UBOUND(InData%WriteOutputHdrforPE,1) + DO I = 1, LEN(InData%WriteOutputHdrforPE) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrforPE(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUntforPE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntforPE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntforPE,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUntforPE,1), UBOUND(InData%WriteOutputUntforPE,1) + DO I = 1, LEN(InData%WriteOutputUntforPE) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntforPE(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputHdrSep) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrSep,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrSep,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdrSep,1), UBOUND(InData%WriteOutputHdrSep,1) + DO I = 1, LEN(InData%WriteOutputHdrSep) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrSep(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUntSep) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntSep,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntSep,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUntSep,1), UBOUND(InData%WriteOutputUntSep,1) + DO I = 1, LEN(InData%WriteOutputUntSep) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntSep(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputHdrNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdrNodes,1), UBOUND(InData%WriteOutputHdrNodes,1) + DO I = 1, LEN(InData%WriteOutputHdrNodes) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrNodes(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUntNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUntNodes,1), UBOUND(InData%WriteOutputUntNodes,1) + DO I = 1, LEN(InData%WriteOutputUntNodes) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntNodes(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_PackInitOutput + + SUBROUTINE AA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrforPE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdrforPE)) DEALLOCATE(OutData%WriteOutputHdrforPE) + ALLOCATE(OutData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdrforPE,1), UBOUND(OutData%WriteOutputHdrforPE,1) + DO I = 1, LEN(OutData%WriteOutputHdrforPE) + OutData%WriteOutputHdrforPE(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUntforPE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUntforPE)) DEALLOCATE(OutData%WriteOutputUntforPE) + ALLOCATE(OutData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUntforPE,1), UBOUND(OutData%WriteOutputUntforPE,1) + DO I = 1, LEN(OutData%WriteOutputUntforPE) + OutData%WriteOutputUntforPE(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrSep not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdrSep)) DEALLOCATE(OutData%WriteOutputHdrSep) + ALLOCATE(OutData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdrSep,1), UBOUND(OutData%WriteOutputHdrSep,1) + DO I = 1, LEN(OutData%WriteOutputHdrSep) + OutData%WriteOutputHdrSep(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUntSep not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUntSep)) DEALLOCATE(OutData%WriteOutputUntSep) + ALLOCATE(OutData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUntSep,1), UBOUND(OutData%WriteOutputUntSep,1) + DO I = 1, LEN(OutData%WriteOutputUntSep) + OutData%WriteOutputUntSep(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdrNodes)) DEALLOCATE(OutData%WriteOutputHdrNodes) + ALLOCATE(OutData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdrNodes,1), UBOUND(OutData%WriteOutputHdrNodes,1) + DO I = 1, LEN(OutData%WriteOutputHdrNodes) + OutData%WriteOutputHdrNodes(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUntNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUntNodes)) DEALLOCATE(OutData%WriteOutputUntNodes) + ALLOCATE(OutData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUntNodes,1), UBOUND(OutData%WriteOutputUntNodes,1) + DO I = 1, LEN(OutData%WriteOutputUntNodes) + OutData%WriteOutputUntNodes(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%delim) + OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_UnPackInitOutput + + SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_InputFile), INTENT(IN) :: SrcInputFileData + TYPE(AA_InputFile), INTENT(INOUT) :: DstInputFileData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInputFile' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputFileData%DT_AA = SrcInputFileData%DT_AA + DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT + DstInputFileData%ILAM = SrcInputFileData%ILAM + DstInputFileData%ITIP = SrcInputFileData%ITIP + DstInputFileData%ITRIP = SrcInputFileData%ITRIP + DstInputFileData%ITURB = SrcInputFileData%ITURB + DstInputFileData%IInflow = SrcInputFileData%IInflow + DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod + DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth + DstInputFileData%NReListBL = SrcInputFileData%NReListBL + DstInputFileData%aweightflag = SrcInputFileData%aweightflag + DstInputFileData%ROUND = SrcInputFileData%ROUND + DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT + DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge + DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc +IF (ALLOCATED(SrcInputFileData%ObsX)) THEN + i1_l = LBOUND(SrcInputFileData%ObsX,1) + i1_u = UBOUND(SrcInputFileData%ObsX,1) + IF (.NOT. ALLOCATED(DstInputFileData%ObsX)) THEN + ALLOCATE(DstInputFileData%ObsX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%ObsX = SrcInputFileData%ObsX +ENDIF +IF (ALLOCATED(SrcInputFileData%ObsY)) THEN + i1_l = LBOUND(SrcInputFileData%ObsY,1) + i1_u = UBOUND(SrcInputFileData%ObsY,1) + IF (.NOT. ALLOCATED(DstInputFileData%ObsY)) THEN + ALLOCATE(DstInputFileData%ObsY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%ObsY = SrcInputFileData%ObsY +ENDIF +IF (ALLOCATED(SrcInputFileData%ObsZ)) THEN + i1_l = LBOUND(SrcInputFileData%ObsZ,1) + i1_u = UBOUND(SrcInputFileData%ObsZ,1) + IF (.NOT. ALLOCATED(DstInputFileData%ObsZ)) THEN + ALLOCATE(DstInputFileData%ObsZ(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%ObsZ = SrcInputFileData%ObsZ +ENDIF +IF (ALLOCATED(SrcInputFileData%BladeProps)) THEN + i1_l = LBOUND(SrcInputFileData%BladeProps,1) + i1_u = UBOUND(SrcInputFileData%BladeProps,1) + IF (.NOT. ALLOCATED(DstInputFileData%BladeProps)) THEN + ALLOCATE(DstInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputFileData%BladeProps,1), UBOUND(SrcInputFileData%BladeProps,1) + CALL AA_Copybladepropstype( SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile +IF (ALLOCATED(SrcInputFileData%AAoutfile)) THEN + i1_l = LBOUND(SrcInputFileData%AAoutfile,1) + i1_u = UBOUND(SrcInputFileData%AAoutfile,1) + IF (.NOT. ALLOCATED(DstInputFileData%AAoutfile)) THEN + ALLOCATE(DstInputFileData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile +ENDIF + DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile + DstInputFileData%FTitle = SrcInputFileData%FTitle + DstInputFileData%AAStart = SrcInputFileData%AAStart + DstInputFileData%z0_AA = SrcInputFileData%z0_AA +IF (ALLOCATED(SrcInputFileData%ReListBL)) THEN + i1_l = LBOUND(SrcInputFileData%ReListBL,1) + i1_u = UBOUND(SrcInputFileData%ReListBL,1) + IF (.NOT. ALLOCATED(DstInputFileData%ReListBL)) THEN + ALLOCATE(DstInputFileData%ReListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%ReListBL = SrcInputFileData%ReListBL +ENDIF +IF (ALLOCATED(SrcInputFileData%AoAListBL)) THEN + i1_l = LBOUND(SrcInputFileData%AoAListBL,1) + i1_u = UBOUND(SrcInputFileData%AoAListBL,1) + IF (.NOT. ALLOCATED(DstInputFileData%AoAListBL)) THEN + ALLOCATE(DstInputFileData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL +ENDIF +IF (ALLOCATED(SrcInputFileData%Pres_DispThick)) THEN + i1_l = LBOUND(SrcInputFileData%Pres_DispThick,1) + i1_u = UBOUND(SrcInputFileData%Pres_DispThick,1) + i2_l = LBOUND(SrcInputFileData%Pres_DispThick,2) + i2_u = UBOUND(SrcInputFileData%Pres_DispThick,2) + i3_l = LBOUND(SrcInputFileData%Pres_DispThick,3) + i3_u = UBOUND(SrcInputFileData%Pres_DispThick,3) + IF (.NOT. ALLOCATED(DstInputFileData%Pres_DispThick)) THEN + ALLOCATE(DstInputFileData%Pres_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick +ENDIF +IF (ALLOCATED(SrcInputFileData%Suct_DispThick)) THEN + i1_l = LBOUND(SrcInputFileData%Suct_DispThick,1) + i1_u = UBOUND(SrcInputFileData%Suct_DispThick,1) + i2_l = LBOUND(SrcInputFileData%Suct_DispThick,2) + i2_u = UBOUND(SrcInputFileData%Suct_DispThick,2) + i3_l = LBOUND(SrcInputFileData%Suct_DispThick,3) + i3_u = UBOUND(SrcInputFileData%Suct_DispThick,3) + IF (.NOT. ALLOCATED(DstInputFileData%Suct_DispThick)) THEN + ALLOCATE(DstInputFileData%Suct_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick +ENDIF +IF (ALLOCATED(SrcInputFileData%Pres_BLThick)) THEN + i1_l = LBOUND(SrcInputFileData%Pres_BLThick,1) + i1_u = UBOUND(SrcInputFileData%Pres_BLThick,1) + i2_l = LBOUND(SrcInputFileData%Pres_BLThick,2) + i2_u = UBOUND(SrcInputFileData%Pres_BLThick,2) + i3_l = LBOUND(SrcInputFileData%Pres_BLThick,3) + i3_u = UBOUND(SrcInputFileData%Pres_BLThick,3) + IF (.NOT. ALLOCATED(DstInputFileData%Pres_BLThick)) THEN + ALLOCATE(DstInputFileData%Pres_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick +ENDIF +IF (ALLOCATED(SrcInputFileData%Suct_BLThick)) THEN + i1_l = LBOUND(SrcInputFileData%Suct_BLThick,1) + i1_u = UBOUND(SrcInputFileData%Suct_BLThick,1) + i2_l = LBOUND(SrcInputFileData%Suct_BLThick,2) + i2_u = UBOUND(SrcInputFileData%Suct_BLThick,2) + i3_l = LBOUND(SrcInputFileData%Suct_BLThick,3) + i3_u = UBOUND(SrcInputFileData%Suct_BLThick,3) + IF (.NOT. ALLOCATED(DstInputFileData%Suct_BLThick)) THEN + ALLOCATE(DstInputFileData%Suct_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick +ENDIF +IF (ALLOCATED(SrcInputFileData%Pres_Cf)) THEN + i1_l = LBOUND(SrcInputFileData%Pres_Cf,1) + i1_u = UBOUND(SrcInputFileData%Pres_Cf,1) + i2_l = LBOUND(SrcInputFileData%Pres_Cf,2) + i2_u = UBOUND(SrcInputFileData%Pres_Cf,2) + i3_l = LBOUND(SrcInputFileData%Pres_Cf,3) + i3_u = UBOUND(SrcInputFileData%Pres_Cf,3) + IF (.NOT. ALLOCATED(DstInputFileData%Pres_Cf)) THEN + ALLOCATE(DstInputFileData%Pres_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf +ENDIF +IF (ALLOCATED(SrcInputFileData%Suct_Cf)) THEN + i1_l = LBOUND(SrcInputFileData%Suct_Cf,1) + i1_u = UBOUND(SrcInputFileData%Suct_Cf,1) + i2_l = LBOUND(SrcInputFileData%Suct_Cf,2) + i2_u = UBOUND(SrcInputFileData%Suct_Cf,2) + i3_l = LBOUND(SrcInputFileData%Suct_Cf,3) + i3_u = UBOUND(SrcInputFileData%Suct_Cf,3) + IF (.NOT. ALLOCATED(DstInputFileData%Suct_Cf)) THEN + ALLOCATE(DstInputFileData%Suct_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf +ENDIF +IF (ALLOCATED(SrcInputFileData%Pres_EdgeVelRat)) THEN + i1_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,1) + i1_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,1) + i2_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,2) + i2_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,2) + i3_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,3) + i3_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,3) + IF (.NOT. ALLOCATED(DstInputFileData%Pres_EdgeVelRat)) THEN + ALLOCATE(DstInputFileData%Pres_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat +ENDIF +IF (ALLOCATED(SrcInputFileData%Suct_EdgeVelRat)) THEN + i1_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,1) + i1_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,1) + i2_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,2) + i2_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,2) + i3_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,3) + i3_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,3) + IF (.NOT. ALLOCATED(DstInputFileData%Suct_EdgeVelRat)) THEN + ALLOCATE(DstInputFileData%Suct_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat +ENDIF +IF (ALLOCATED(SrcInputFileData%TI_Grid_In)) THEN + i1_l = LBOUND(SrcInputFileData%TI_Grid_In,1) + i1_u = UBOUND(SrcInputFileData%TI_Grid_In,1) + i2_l = LBOUND(SrcInputFileData%TI_Grid_In,2) + i2_u = UBOUND(SrcInputFileData%TI_Grid_In,2) + IF (.NOT. ALLOCATED(DstInputFileData%TI_Grid_In)) THEN + ALLOCATE(DstInputFileData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In +ENDIF + DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in + DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in + END SUBROUTINE AA_CopyInputFile + + SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInputFile' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InputFileData%ObsX)) THEN + DEALLOCATE(InputFileData%ObsX) +ENDIF +IF (ALLOCATED(InputFileData%ObsY)) THEN + DEALLOCATE(InputFileData%ObsY) +ENDIF +IF (ALLOCATED(InputFileData%ObsZ)) THEN + DEALLOCATE(InputFileData%ObsZ) +ENDIF +IF (ALLOCATED(InputFileData%BladeProps)) THEN +DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) + CALL AA_Destroybladepropstype( InputFileData%BladeProps(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InputFileData%BladeProps) +ENDIF +IF (ALLOCATED(InputFileData%AAoutfile)) THEN + DEALLOCATE(InputFileData%AAoutfile) +ENDIF +IF (ALLOCATED(InputFileData%ReListBL)) THEN + DEALLOCATE(InputFileData%ReListBL) +ENDIF +IF (ALLOCATED(InputFileData%AoAListBL)) THEN + DEALLOCATE(InputFileData%AoAListBL) +ENDIF +IF (ALLOCATED(InputFileData%Pres_DispThick)) THEN + DEALLOCATE(InputFileData%Pres_DispThick) +ENDIF +IF (ALLOCATED(InputFileData%Suct_DispThick)) THEN + DEALLOCATE(InputFileData%Suct_DispThick) +ENDIF +IF (ALLOCATED(InputFileData%Pres_BLThick)) THEN + DEALLOCATE(InputFileData%Pres_BLThick) +ENDIF +IF (ALLOCATED(InputFileData%Suct_BLThick)) THEN + DEALLOCATE(InputFileData%Suct_BLThick) +ENDIF +IF (ALLOCATED(InputFileData%Pres_Cf)) THEN + DEALLOCATE(InputFileData%Pres_Cf) +ENDIF +IF (ALLOCATED(InputFileData%Suct_Cf)) THEN + DEALLOCATE(InputFileData%Suct_Cf) +ENDIF +IF (ALLOCATED(InputFileData%Pres_EdgeVelRat)) THEN + DEALLOCATE(InputFileData%Pres_EdgeVelRat) +ENDIF +IF (ALLOCATED(InputFileData%Suct_EdgeVelRat)) THEN + DEALLOCATE(InputFileData%Suct_EdgeVelRat) +ENDIF +IF (ALLOCATED(InputFileData%TI_Grid_In)) THEN + DEALLOCATE(InputFileData%TI_Grid_In) +ENDIF + END SUBROUTINE AA_DestroyInputFile + + SUBROUTINE AA_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_InputFile), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInputFile' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT_AA + Int_BufSz = Int_BufSz + 1 ! IBLUNT + Int_BufSz = Int_BufSz + 1 ! ILAM + Int_BufSz = Int_BufSz + 1 ! ITIP + Int_BufSz = Int_BufSz + 1 ! ITRIP + Int_BufSz = Int_BufSz + 1 ! ITURB + Int_BufSz = Int_BufSz + 1 ! IInflow + Int_BufSz = Int_BufSz + 1 ! X_BLMethod + Int_BufSz = Int_BufSz + 1 ! TICalcMeth + Int_BufSz = Int_BufSz + 1 ! NReListBL + Int_BufSz = Int_BufSz + 1 ! aweightflag + Int_BufSz = Int_BufSz + 1 ! ROUND + Re_BufSz = Re_BufSz + 1 ! ALPRAT + Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge + Int_BufSz = Int_BufSz + 1 ! NrObsLoc + Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no + IF ( ALLOCATED(InData%ObsX) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX + END IF + Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no + IF ( ALLOCATED(InData%ObsY) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY + END IF + Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no + IF ( ALLOCATED(InData%ObsZ) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ + END IF + Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no + IF ( ALLOCATED(InData%BladeProps) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) + Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype + CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeProps + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeProps + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeProps + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! NrOutFile + Int_BufSz = Int_BufSz + 1 ! AAoutfile allocated yes/no + IF ( ALLOCATED(InData%AAoutfile) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AAoutfile upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%AAoutfile)*LEN(InData%AAoutfile) ! AAoutfile + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%TICalcTabFile) ! TICalcTabFile + Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle + Db_BufSz = Db_BufSz + 1 ! AAStart + Re_BufSz = Re_BufSz + 1 ! z0_AA + Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no + IF ( ALLOCATED(InData%ReListBL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL + END IF + Int_BufSz = Int_BufSz + 1 ! AoAListBL allocated yes/no + IF ( ALLOCATED(InData%AoAListBL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AoAListBL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AoAListBL) ! AoAListBL + END IF + Int_BufSz = Int_BufSz + 1 ! Pres_DispThick allocated yes/no + IF ( ALLOCATED(InData%Pres_DispThick) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Pres_DispThick upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Pres_DispThick) ! Pres_DispThick + END IF + Int_BufSz = Int_BufSz + 1 ! Suct_DispThick allocated yes/no + IF ( ALLOCATED(InData%Suct_DispThick) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Suct_DispThick upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Suct_DispThick) ! Suct_DispThick + END IF + Int_BufSz = Int_BufSz + 1 ! Pres_BLThick allocated yes/no + IF ( ALLOCATED(InData%Pres_BLThick) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Pres_BLThick upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Pres_BLThick) ! Pres_BLThick + END IF + Int_BufSz = Int_BufSz + 1 ! Suct_BLThick allocated yes/no + IF ( ALLOCATED(InData%Suct_BLThick) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Suct_BLThick upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Suct_BLThick) ! Suct_BLThick + END IF + Int_BufSz = Int_BufSz + 1 ! Pres_Cf allocated yes/no + IF ( ALLOCATED(InData%Pres_Cf) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Pres_Cf upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Pres_Cf) ! Pres_Cf + END IF + Int_BufSz = Int_BufSz + 1 ! Suct_Cf allocated yes/no + IF ( ALLOCATED(InData%Suct_Cf) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Suct_Cf upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Suct_Cf) ! Suct_Cf + END IF + Int_BufSz = Int_BufSz + 1 ! Pres_EdgeVelRat allocated yes/no + IF ( ALLOCATED(InData%Pres_EdgeVelRat) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Pres_EdgeVelRat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Pres_EdgeVelRat) ! Pres_EdgeVelRat + END IF + Int_BufSz = Int_BufSz + 1 ! Suct_EdgeVelRat allocated yes/no + IF ( ALLOCATED(InData%Suct_EdgeVelRat) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Suct_EdgeVelRat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Suct_EdgeVelRat) ! Suct_EdgeVelRat + END IF + Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no + IF ( ALLOCATED(InData%TI_Grid_In) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In + END IF + Re_BufSz = Re_BufSz + 1 ! dz_turb_in + Re_BufSz = Re_BufSz + 1 ! dy_turb_in + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT_AA + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IBLUNT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ILAM + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ITIP + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ITRIP + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ITURB + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IInflow + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%X_BLMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TICalcMeth + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NReListBL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ALPRAT + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NrObsLoc + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ObsX) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsX,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) + ReKiBuf(Re_Xferred) = InData%ObsX(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ObsY) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsY,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) + ReKiBuf(Re_Xferred) = InData%ObsY(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ObsZ) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsZ,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) + ReKiBuf(Re_Xferred) = InData%ObsZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) + CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NrOutFile + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%AAoutfile) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AAoutfile,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAoutfile,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AAoutfile,1), UBOUND(InData%AAoutfile,1) + DO I = 1, LEN(InData%AAoutfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AAoutfile(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%TICalcTabFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TICalcTabFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%FTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%AAStart + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z0_AA + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ReListBL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) + ReKiBuf(Re_Xferred) = InData%ReListBL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AoAListBL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AoAListBL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoAListBL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AoAListBL,1), UBOUND(InData%AoAListBL,1) + ReKiBuf(Re_Xferred) = InData%AoAListBL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Pres_DispThick) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Pres_DispThick,3), UBOUND(InData%Pres_DispThick,3) + DO i2 = LBOUND(InData%Pres_DispThick,2), UBOUND(InData%Pres_DispThick,2) + DO i1 = LBOUND(InData%Pres_DispThick,1), UBOUND(InData%Pres_DispThick,1) + ReKiBuf(Re_Xferred) = InData%Pres_DispThick(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Suct_DispThick) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Suct_DispThick,3), UBOUND(InData%Suct_DispThick,3) + DO i2 = LBOUND(InData%Suct_DispThick,2), UBOUND(InData%Suct_DispThick,2) + DO i1 = LBOUND(InData%Suct_DispThick,1), UBOUND(InData%Suct_DispThick,1) + ReKiBuf(Re_Xferred) = InData%Suct_DispThick(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Pres_BLThick) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Pres_BLThick,3), UBOUND(InData%Pres_BLThick,3) + DO i2 = LBOUND(InData%Pres_BLThick,2), UBOUND(InData%Pres_BLThick,2) + DO i1 = LBOUND(InData%Pres_BLThick,1), UBOUND(InData%Pres_BLThick,1) + ReKiBuf(Re_Xferred) = InData%Pres_BLThick(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Suct_BLThick) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Suct_BLThick,3), UBOUND(InData%Suct_BLThick,3) + DO i2 = LBOUND(InData%Suct_BLThick,2), UBOUND(InData%Suct_BLThick,2) + DO i1 = LBOUND(InData%Suct_BLThick,1), UBOUND(InData%Suct_BLThick,1) + ReKiBuf(Re_Xferred) = InData%Suct_BLThick(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Pres_Cf) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Pres_Cf,3), UBOUND(InData%Pres_Cf,3) + DO i2 = LBOUND(InData%Pres_Cf,2), UBOUND(InData%Pres_Cf,2) + DO i1 = LBOUND(InData%Pres_Cf,1), UBOUND(InData%Pres_Cf,1) + ReKiBuf(Re_Xferred) = InData%Pres_Cf(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Suct_Cf) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Suct_Cf,3), UBOUND(InData%Suct_Cf,3) + DO i2 = LBOUND(InData%Suct_Cf,2), UBOUND(InData%Suct_Cf,2) + DO i1 = LBOUND(InData%Suct_Cf,1), UBOUND(InData%Suct_Cf,1) + ReKiBuf(Re_Xferred) = InData%Suct_Cf(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Pres_EdgeVelRat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Pres_EdgeVelRat,3), UBOUND(InData%Pres_EdgeVelRat,3) + DO i2 = LBOUND(InData%Pres_EdgeVelRat,2), UBOUND(InData%Pres_EdgeVelRat,2) + DO i1 = LBOUND(InData%Pres_EdgeVelRat,1), UBOUND(InData%Pres_EdgeVelRat,1) + ReKiBuf(Re_Xferred) = InData%Pres_EdgeVelRat(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Suct_EdgeVelRat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Suct_EdgeVelRat,3), UBOUND(InData%Suct_EdgeVelRat,3) + DO i2 = LBOUND(InData%Suct_EdgeVelRat,2), UBOUND(InData%Suct_EdgeVelRat,2) + DO i1 = LBOUND(InData%Suct_EdgeVelRat,1), UBOUND(InData%Suct_EdgeVelRat,1) + ReKiBuf(Re_Xferred) = InData%Suct_EdgeVelRat(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) + DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) + ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%dz_turb_in + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dy_turb_in + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_PackInputFile + + SUBROUTINE AA_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_InputFile), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInputFile' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT_AA = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%IBLUNT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ILAM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ITIP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ITRIP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ITURB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%X_BLMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TICalcMeth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NReListBL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) + Int_Xferred = Int_Xferred + 1 + OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) + Int_Xferred = Int_Xferred + 1 + OutData%ALPRAT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NrObsLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ObsX)) DEALLOCATE(OutData%ObsX) + ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) + OutData%ObsX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ObsY)) DEALLOCATE(OutData%ObsY) + ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) + OutData%ObsY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ObsZ)) DEALLOCATE(OutData%ObsZ) + ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) + OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeProps)) DEALLOCATE(OutData%BladeProps) + ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AA_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%NrOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAoutfile not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AAoutfile)) DEALLOCATE(OutData%AAoutfile) + ALLOCATE(OutData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AAoutfile,1), UBOUND(OutData%AAoutfile,1) + DO I = 1, LEN(OutData%AAoutfile) + OutData%AAoutfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%TICalcTabFile) + OutData%TICalcTabFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%FTitle) + OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AAStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%z0_AA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ReListBL)) DEALLOCATE(OutData%ReListBL) + ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) + OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoAListBL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AoAListBL)) DEALLOCATE(OutData%AoAListBL) + ALLOCATE(OutData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AoAListBL,1), UBOUND(OutData%AoAListBL,1) + OutData%AoAListBL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_DispThick not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Pres_DispThick)) DEALLOCATE(OutData%Pres_DispThick) + ALLOCATE(OutData%Pres_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Pres_DispThick,3), UBOUND(OutData%Pres_DispThick,3) + DO i2 = LBOUND(OutData%Pres_DispThick,2), UBOUND(OutData%Pres_DispThick,2) + DO i1 = LBOUND(OutData%Pres_DispThick,1), UBOUND(OutData%Pres_DispThick,1) + OutData%Pres_DispThick(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_DispThick not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Suct_DispThick)) DEALLOCATE(OutData%Suct_DispThick) + ALLOCATE(OutData%Suct_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Suct_DispThick,3), UBOUND(OutData%Suct_DispThick,3) + DO i2 = LBOUND(OutData%Suct_DispThick,2), UBOUND(OutData%Suct_DispThick,2) + DO i1 = LBOUND(OutData%Suct_DispThick,1), UBOUND(OutData%Suct_DispThick,1) + OutData%Suct_DispThick(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_BLThick not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Pres_BLThick)) DEALLOCATE(OutData%Pres_BLThick) + ALLOCATE(OutData%Pres_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Pres_BLThick,3), UBOUND(OutData%Pres_BLThick,3) + DO i2 = LBOUND(OutData%Pres_BLThick,2), UBOUND(OutData%Pres_BLThick,2) + DO i1 = LBOUND(OutData%Pres_BLThick,1), UBOUND(OutData%Pres_BLThick,1) + OutData%Pres_BLThick(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_BLThick not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Suct_BLThick)) DEALLOCATE(OutData%Suct_BLThick) + ALLOCATE(OutData%Suct_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Suct_BLThick,3), UBOUND(OutData%Suct_BLThick,3) + DO i2 = LBOUND(OutData%Suct_BLThick,2), UBOUND(OutData%Suct_BLThick,2) + DO i1 = LBOUND(OutData%Suct_BLThick,1), UBOUND(OutData%Suct_BLThick,1) + OutData%Suct_BLThick(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_Cf not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Pres_Cf)) DEALLOCATE(OutData%Pres_Cf) + ALLOCATE(OutData%Pres_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_Cf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Pres_Cf,3), UBOUND(OutData%Pres_Cf,3) + DO i2 = LBOUND(OutData%Pres_Cf,2), UBOUND(OutData%Pres_Cf,2) + DO i1 = LBOUND(OutData%Pres_Cf,1), UBOUND(OutData%Pres_Cf,1) + OutData%Pres_Cf(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_Cf not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Suct_Cf)) DEALLOCATE(OutData%Suct_Cf) + ALLOCATE(OutData%Suct_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_Cf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Suct_Cf,3), UBOUND(OutData%Suct_Cf,3) + DO i2 = LBOUND(OutData%Suct_Cf,2), UBOUND(OutData%Suct_Cf,2) + DO i1 = LBOUND(OutData%Suct_Cf,1), UBOUND(OutData%Suct_Cf,1) + OutData%Suct_Cf(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_EdgeVelRat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Pres_EdgeVelRat)) DEALLOCATE(OutData%Pres_EdgeVelRat) + ALLOCATE(OutData%Pres_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Pres_EdgeVelRat,3), UBOUND(OutData%Pres_EdgeVelRat,3) + DO i2 = LBOUND(OutData%Pres_EdgeVelRat,2), UBOUND(OutData%Pres_EdgeVelRat,2) + DO i1 = LBOUND(OutData%Pres_EdgeVelRat,1), UBOUND(OutData%Pres_EdgeVelRat,1) + OutData%Pres_EdgeVelRat(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_EdgeVelRat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Suct_EdgeVelRat)) DEALLOCATE(OutData%Suct_EdgeVelRat) + ALLOCATE(OutData%Suct_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Suct_EdgeVelRat,3), UBOUND(OutData%Suct_EdgeVelRat,3) + DO i2 = LBOUND(OutData%Suct_EdgeVelRat,2), UBOUND(OutData%Suct_EdgeVelRat,2) + DO i1 = LBOUND(OutData%Suct_EdgeVelRat,1), UBOUND(OutData%Suct_EdgeVelRat,1) + OutData%Suct_EdgeVelRat(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TI_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) + ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) + DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) + OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%dz_turb_in = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dy_turb_in = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_UnPackInputFile + + SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(AA_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstContStateData%DummyContState = SrcContStateData%DummyContState + END SUBROUTINE AA_CopyContState + + SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(AA_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE AA_DestroyContState + + SUBROUTINE AA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyContState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_PackContState + + SUBROUTINE AA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_UnPackContState + + SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcDiscStateData%MeanVrel)) THEN + i1_l = LBOUND(SrcDiscStateData%MeanVrel,1) + i1_u = UBOUND(SrcDiscStateData%MeanVrel,1) + i2_l = LBOUND(SrcDiscStateData%MeanVrel,2) + i2_u = UBOUND(SrcDiscStateData%MeanVrel,2) + IF (.NOT. ALLOCATED(DstDiscStateData%MeanVrel)) THEN + ALLOCATE(DstDiscStateData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel +ENDIF +IF (ALLOCATED(SrcDiscStateData%VrelSq)) THEN + i1_l = LBOUND(SrcDiscStateData%VrelSq,1) + i1_u = UBOUND(SrcDiscStateData%VrelSq,1) + i2_l = LBOUND(SrcDiscStateData%VrelSq,2) + i2_u = UBOUND(SrcDiscStateData%VrelSq,2) + IF (.NOT. ALLOCATED(DstDiscStateData%VrelSq)) THEN + ALLOCATE(DstDiscStateData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq +ENDIF +IF (ALLOCATED(SrcDiscStateData%TIVrel)) THEN + i1_l = LBOUND(SrcDiscStateData%TIVrel,1) + i1_u = UBOUND(SrcDiscStateData%TIVrel,1) + i2_l = LBOUND(SrcDiscStateData%TIVrel,2) + i2_u = UBOUND(SrcDiscStateData%TIVrel,2) + IF (.NOT. ALLOCATED(DstDiscStateData%TIVrel)) THEN + ALLOCATE(DstDiscStateData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel +ENDIF +IF (ALLOCATED(SrcDiscStateData%VrelStore)) THEN + i1_l = LBOUND(SrcDiscStateData%VrelStore,1) + i1_u = UBOUND(SrcDiscStateData%VrelStore,1) + i2_l = LBOUND(SrcDiscStateData%VrelStore,2) + i2_u = UBOUND(SrcDiscStateData%VrelStore,2) + i3_l = LBOUND(SrcDiscStateData%VrelStore,3) + i3_u = UBOUND(SrcDiscStateData%VrelStore,3) + IF (.NOT. ALLOCATED(DstDiscStateData%VrelStore)) THEN + ALLOCATE(DstDiscStateData%VrelStore(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore +ENDIF +IF (ALLOCATED(SrcDiscStateData%TIVx)) THEN + i1_l = LBOUND(SrcDiscStateData%TIVx,1) + i1_u = UBOUND(SrcDiscStateData%TIVx,1) + i2_l = LBOUND(SrcDiscStateData%TIVx,2) + i2_u = UBOUND(SrcDiscStateData%TIVx,2) + IF (.NOT. ALLOCATED(DstDiscStateData%TIVx)) THEN + ALLOCATE(DstDiscStateData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%TIVx = SrcDiscStateData%TIVx +ENDIF +IF (ALLOCATED(SrcDiscStateData%MeanVxVyVz)) THEN + i1_l = LBOUND(SrcDiscStateData%MeanVxVyVz,1) + i1_u = UBOUND(SrcDiscStateData%MeanVxVyVz,1) + i2_l = LBOUND(SrcDiscStateData%MeanVxVyVz,2) + i2_u = UBOUND(SrcDiscStateData%MeanVxVyVz,2) + IF (.NOT. ALLOCATED(DstDiscStateData%MeanVxVyVz)) THEN + ALLOCATE(DstDiscStateData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz +ENDIF +IF (ALLOCATED(SrcDiscStateData%VxSq)) THEN + i1_l = LBOUND(SrcDiscStateData%VxSq,1) + i1_u = UBOUND(SrcDiscStateData%VxSq,1) + i2_l = LBOUND(SrcDiscStateData%VxSq,2) + i2_u = UBOUND(SrcDiscStateData%VxSq,2) + IF (.NOT. ALLOCATED(DstDiscStateData%VxSq)) THEN + ALLOCATE(DstDiscStateData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%VxSq = SrcDiscStateData%VxSq +ENDIF +IF (ALLOCATED(SrcDiscStateData%allregcounter)) THEN + i1_l = LBOUND(SrcDiscStateData%allregcounter,1) + i1_u = UBOUND(SrcDiscStateData%allregcounter,1) + i2_l = LBOUND(SrcDiscStateData%allregcounter,2) + i2_u = UBOUND(SrcDiscStateData%allregcounter,2) + IF (.NOT. ALLOCATED(DstDiscStateData%allregcounter)) THEN + ALLOCATE(DstDiscStateData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter +ENDIF +IF (ALLOCATED(SrcDiscStateData%VxSqRegion)) THEN + i1_l = LBOUND(SrcDiscStateData%VxSqRegion,1) + i1_u = UBOUND(SrcDiscStateData%VxSqRegion,1) + i2_l = LBOUND(SrcDiscStateData%VxSqRegion,2) + i2_u = UBOUND(SrcDiscStateData%VxSqRegion,2) + IF (.NOT. ALLOCATED(DstDiscStateData%VxSqRegion)) THEN + ALLOCATE(DstDiscStateData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion +ENDIF +IF (ALLOCATED(SrcDiscStateData%RegVxStor)) THEN + i1_l = LBOUND(SrcDiscStateData%RegVxStor,1) + i1_u = UBOUND(SrcDiscStateData%RegVxStor,1) + i2_l = LBOUND(SrcDiscStateData%RegVxStor,2) + i2_u = UBOUND(SrcDiscStateData%RegVxStor,2) + i3_l = LBOUND(SrcDiscStateData%RegVxStor,3) + i3_u = UBOUND(SrcDiscStateData%RegVxStor,3) + IF (.NOT. ALLOCATED(DstDiscStateData%RegVxStor)) THEN + ALLOCATE(DstDiscStateData%RegVxStor(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor +ENDIF +IF (ALLOCATED(SrcDiscStateData%RegionTIDelete)) THEN + i1_l = LBOUND(SrcDiscStateData%RegionTIDelete,1) + i1_u = UBOUND(SrcDiscStateData%RegionTIDelete,1) + i2_l = LBOUND(SrcDiscStateData%RegionTIDelete,2) + i2_u = UBOUND(SrcDiscStateData%RegionTIDelete,2) + IF (.NOT. ALLOCATED(DstDiscStateData%RegionTIDelete)) THEN + ALLOCATE(DstDiscStateData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete +ENDIF + END SUBROUTINE AA_CopyDiscState + + SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyDiscState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(DiscStateData%MeanVrel)) THEN + DEALLOCATE(DiscStateData%MeanVrel) +ENDIF +IF (ALLOCATED(DiscStateData%VrelSq)) THEN + DEALLOCATE(DiscStateData%VrelSq) +ENDIF +IF (ALLOCATED(DiscStateData%TIVrel)) THEN + DEALLOCATE(DiscStateData%TIVrel) +ENDIF +IF (ALLOCATED(DiscStateData%VrelStore)) THEN + DEALLOCATE(DiscStateData%VrelStore) +ENDIF +IF (ALLOCATED(DiscStateData%TIVx)) THEN + DEALLOCATE(DiscStateData%TIVx) +ENDIF +IF (ALLOCATED(DiscStateData%MeanVxVyVz)) THEN + DEALLOCATE(DiscStateData%MeanVxVyVz) +ENDIF +IF (ALLOCATED(DiscStateData%VxSq)) THEN + DEALLOCATE(DiscStateData%VxSq) +ENDIF +IF (ALLOCATED(DiscStateData%allregcounter)) THEN + DEALLOCATE(DiscStateData%allregcounter) +ENDIF +IF (ALLOCATED(DiscStateData%VxSqRegion)) THEN + DEALLOCATE(DiscStateData%VxSqRegion) +ENDIF +IF (ALLOCATED(DiscStateData%RegVxStor)) THEN + DEALLOCATE(DiscStateData%RegVxStor) +ENDIF +IF (ALLOCATED(DiscStateData%RegionTIDelete)) THEN + DEALLOCATE(DiscStateData%RegionTIDelete) +ENDIF + END SUBROUTINE AA_DestroyDiscState + + SUBROUTINE AA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! MeanVrel allocated yes/no + IF ( ALLOCATED(InData%MeanVrel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MeanVrel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MeanVrel) ! MeanVrel + END IF + Int_BufSz = Int_BufSz + 1 ! VrelSq allocated yes/no + IF ( ALLOCATED(InData%VrelSq) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! VrelSq upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%VrelSq) ! VrelSq + END IF + Int_BufSz = Int_BufSz + 1 ! TIVrel allocated yes/no + IF ( ALLOCATED(InData%TIVrel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TIVrel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TIVrel) ! TIVrel + END IF + Int_BufSz = Int_BufSz + 1 ! VrelStore allocated yes/no + IF ( ALLOCATED(InData%VrelStore) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! VrelStore upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%VrelStore) ! VrelStore + END IF + Int_BufSz = Int_BufSz + 1 ! TIVx allocated yes/no + IF ( ALLOCATED(InData%TIVx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TIVx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TIVx) ! TIVx + END IF + Int_BufSz = Int_BufSz + 1 ! MeanVxVyVz allocated yes/no + IF ( ALLOCATED(InData%MeanVxVyVz) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MeanVxVyVz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MeanVxVyVz) ! MeanVxVyVz + END IF + Int_BufSz = Int_BufSz + 1 ! VxSq allocated yes/no + IF ( ALLOCATED(InData%VxSq) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! VxSq upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%VxSq) ! VxSq + END IF + Int_BufSz = Int_BufSz + 1 ! allregcounter allocated yes/no + IF ( ALLOCATED(InData%allregcounter) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! allregcounter upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%allregcounter) ! allregcounter + END IF + Int_BufSz = Int_BufSz + 1 ! VxSqRegion allocated yes/no + IF ( ALLOCATED(InData%VxSqRegion) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! VxSqRegion upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%VxSqRegion) ! VxSqRegion + END IF + Int_BufSz = Int_BufSz + 1 ! RegVxStor allocated yes/no + IF ( ALLOCATED(InData%RegVxStor) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! RegVxStor upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%RegVxStor) ! RegVxStor + END IF + Int_BufSz = Int_BufSz + 1 ! RegionTIDelete allocated yes/no + IF ( ALLOCATED(InData%RegionTIDelete) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! RegionTIDelete upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%RegionTIDelete) ! RegionTIDelete + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%MeanVrel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MeanVrel,2), UBOUND(InData%MeanVrel,2) + DO i1 = LBOUND(InData%MeanVrel,1), UBOUND(InData%MeanVrel,1) + ReKiBuf(Re_Xferred) = InData%MeanVrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VrelSq) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%VrelSq,2), UBOUND(InData%VrelSq,2) + DO i1 = LBOUND(InData%VrelSq,1), UBOUND(InData%VrelSq,1) + ReKiBuf(Re_Xferred) = InData%VrelSq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TIVrel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TIVrel,2), UBOUND(InData%TIVrel,2) + DO i1 = LBOUND(InData%TIVrel,1), UBOUND(InData%TIVrel,1) + ReKiBuf(Re_Xferred) = InData%TIVrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VrelStore) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%VrelStore,3), UBOUND(InData%VrelStore,3) + DO i2 = LBOUND(InData%VrelStore,2), UBOUND(InData%VrelStore,2) + DO i1 = LBOUND(InData%VrelStore,1), UBOUND(InData%VrelStore,1) + ReKiBuf(Re_Xferred) = InData%VrelStore(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TIVx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TIVx,2), UBOUND(InData%TIVx,2) + DO i1 = LBOUND(InData%TIVx,1), UBOUND(InData%TIVx,1) + ReKiBuf(Re_Xferred) = InData%TIVx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MeanVxVyVz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MeanVxVyVz,2), UBOUND(InData%MeanVxVyVz,2) + DO i1 = LBOUND(InData%MeanVxVyVz,1), UBOUND(InData%MeanVxVyVz,1) + ReKiBuf(Re_Xferred) = InData%MeanVxVyVz(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VxSq) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%VxSq,2), UBOUND(InData%VxSq,2) + DO i1 = LBOUND(InData%VxSq,1), UBOUND(InData%VxSq,1) + ReKiBuf(Re_Xferred) = InData%VxSq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%allregcounter) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%allregcounter,2), UBOUND(InData%allregcounter,2) + DO i1 = LBOUND(InData%allregcounter,1), UBOUND(InData%allregcounter,1) + ReKiBuf(Re_Xferred) = InData%allregcounter(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VxSqRegion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%VxSqRegion,2), UBOUND(InData%VxSqRegion,2) + DO i1 = LBOUND(InData%VxSqRegion,1), UBOUND(InData%VxSqRegion,1) + ReKiBuf(Re_Xferred) = InData%VxSqRegion(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RegVxStor) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%RegVxStor,3), UBOUND(InData%RegVxStor,3) + DO i2 = LBOUND(InData%RegVxStor,2), UBOUND(InData%RegVxStor,2) + DO i1 = LBOUND(InData%RegVxStor,1), UBOUND(InData%RegVxStor,1) + ReKiBuf(Re_Xferred) = InData%RegVxStor(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RegionTIDelete) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%RegionTIDelete,2), UBOUND(InData%RegionTIDelete,2) + DO i1 = LBOUND(InData%RegionTIDelete,1), UBOUND(InData%RegionTIDelete,1) + ReKiBuf(Re_Xferred) = InData%RegionTIDelete(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AA_PackDiscState + + SUBROUTINE AA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVrel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MeanVrel)) DEALLOCATE(OutData%MeanVrel) + ALLOCATE(OutData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MeanVrel,2), UBOUND(OutData%MeanVrel,2) + DO i1 = LBOUND(OutData%MeanVrel,1), UBOUND(OutData%MeanVrel,1) + OutData%MeanVrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelSq not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VrelSq)) DEALLOCATE(OutData%VrelSq) + ALLOCATE(OutData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%VrelSq,2), UBOUND(OutData%VrelSq,2) + DO i1 = LBOUND(OutData%VrelSq,1), UBOUND(OutData%VrelSq,1) + OutData%VrelSq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVrel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TIVrel)) DEALLOCATE(OutData%TIVrel) + ALLOCATE(OutData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TIVrel,2), UBOUND(OutData%TIVrel,2) + DO i1 = LBOUND(OutData%TIVrel,1), UBOUND(OutData%TIVrel,1) + OutData%TIVrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelStore not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VrelStore)) DEALLOCATE(OutData%VrelStore) + ALLOCATE(OutData%VrelStore(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelStore.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%VrelStore,3), UBOUND(OutData%VrelStore,3) + DO i2 = LBOUND(OutData%VrelStore,2), UBOUND(OutData%VrelStore,2) + DO i1 = LBOUND(OutData%VrelStore,1), UBOUND(OutData%VrelStore,1) + OutData%VrelStore(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TIVx)) DEALLOCATE(OutData%TIVx) + ALLOCATE(OutData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TIVx,2), UBOUND(OutData%TIVx,2) + DO i1 = LBOUND(OutData%TIVx,1), UBOUND(OutData%TIVx,1) + OutData%TIVx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVxVyVz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MeanVxVyVz)) DEALLOCATE(OutData%MeanVxVyVz) + ALLOCATE(OutData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MeanVxVyVz,2), UBOUND(OutData%MeanVxVyVz,2) + DO i1 = LBOUND(OutData%MeanVxVyVz,1), UBOUND(OutData%MeanVxVyVz,1) + OutData%MeanVxVyVz(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSq not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VxSq)) DEALLOCATE(OutData%VxSq) + ALLOCATE(OutData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%VxSq,2), UBOUND(OutData%VxSq,2) + DO i1 = LBOUND(OutData%VxSq,1), UBOUND(OutData%VxSq,1) + OutData%VxSq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! allregcounter not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%allregcounter)) DEALLOCATE(OutData%allregcounter) + ALLOCATE(OutData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%allregcounter,2), UBOUND(OutData%allregcounter,2) + DO i1 = LBOUND(OutData%allregcounter,1), UBOUND(OutData%allregcounter,1) + OutData%allregcounter(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSqRegion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VxSqRegion)) DEALLOCATE(OutData%VxSqRegion) + ALLOCATE(OutData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%VxSqRegion,2), UBOUND(OutData%VxSqRegion,2) + DO i1 = LBOUND(OutData%VxSqRegion,1), UBOUND(OutData%VxSqRegion,1) + OutData%VxSqRegion(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegVxStor not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RegVxStor)) DEALLOCATE(OutData%RegVxStor) + ALLOCATE(OutData%RegVxStor(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegVxStor.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%RegVxStor,3), UBOUND(OutData%RegVxStor,3) + DO i2 = LBOUND(OutData%RegVxStor,2), UBOUND(OutData%RegVxStor,2) + DO i1 = LBOUND(OutData%RegVxStor,1), UBOUND(OutData%RegVxStor,1) + OutData%RegVxStor(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegionTIDelete not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RegionTIDelete)) DEALLOCATE(OutData%RegionTIDelete) + ALLOCATE(OutData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%RegionTIDelete,2), UBOUND(OutData%RegionTIDelete,2) + DO i1 = LBOUND(OutData%RegionTIDelete,1), UBOUND(OutData%RegionTIDelete,1) + OutData%RegionTIDelete(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AA_UnPackDiscState + + SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(AA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE AA_CopyConstrState + + SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(AA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyConstrState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE AA_DestroyConstrState + + SUBROUTINE AA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_PackConstrState + + SUBROUTINE AA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_UnPackConstrState + + SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(AA_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState + END SUBROUTINE AA_CopyOtherState + + SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOtherState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE AA_DestroyOtherState + + SUBROUTINE AA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyOtherState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_PackOtherState + + SUBROUTINE AA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AA_UnPackOtherState + + SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(AA_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscData%AllOuts)) THEN + i1_l = LBOUND(SrcMiscData%AllOuts,1) + i1_u = UBOUND(SrcMiscData%AllOuts,1) + IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN + ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%AllOuts = SrcMiscData%AllOuts +ENDIF +IF (ALLOCATED(SrcMiscData%ChordAngleTE)) THEN + i1_l = LBOUND(SrcMiscData%ChordAngleTE,1) + i1_u = UBOUND(SrcMiscData%ChordAngleTE,1) + i2_l = LBOUND(SrcMiscData%ChordAngleTE,2) + i2_u = UBOUND(SrcMiscData%ChordAngleTE,2) + i3_l = LBOUND(SrcMiscData%ChordAngleTE,3) + i3_u = UBOUND(SrcMiscData%ChordAngleTE,3) + IF (.NOT. ALLOCATED(DstMiscData%ChordAngleTE)) THEN + ALLOCATE(DstMiscData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE +ENDIF +IF (ALLOCATED(SrcMiscData%SpanAngleTE)) THEN + i1_l = LBOUND(SrcMiscData%SpanAngleTE,1) + i1_u = UBOUND(SrcMiscData%SpanAngleTE,1) + i2_l = LBOUND(SrcMiscData%SpanAngleTE,2) + i2_u = UBOUND(SrcMiscData%SpanAngleTE,2) + i3_l = LBOUND(SrcMiscData%SpanAngleTE,3) + i3_u = UBOUND(SrcMiscData%SpanAngleTE,3) + IF (.NOT. ALLOCATED(DstMiscData%SpanAngleTE)) THEN + ALLOCATE(DstMiscData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE +ENDIF +IF (ALLOCATED(SrcMiscData%ChordAngleLE)) THEN + i1_l = LBOUND(SrcMiscData%ChordAngleLE,1) + i1_u = UBOUND(SrcMiscData%ChordAngleLE,1) + i2_l = LBOUND(SrcMiscData%ChordAngleLE,2) + i2_u = UBOUND(SrcMiscData%ChordAngleLE,2) + i3_l = LBOUND(SrcMiscData%ChordAngleLE,3) + i3_u = UBOUND(SrcMiscData%ChordAngleLE,3) + IF (.NOT. ALLOCATED(DstMiscData%ChordAngleLE)) THEN + ALLOCATE(DstMiscData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE +ENDIF +IF (ALLOCATED(SrcMiscData%SpanAngleLE)) THEN + i1_l = LBOUND(SrcMiscData%SpanAngleLE,1) + i1_u = UBOUND(SrcMiscData%SpanAngleLE,1) + i2_l = LBOUND(SrcMiscData%SpanAngleLE,2) + i2_u = UBOUND(SrcMiscData%SpanAngleLE,2) + i3_l = LBOUND(SrcMiscData%SpanAngleLE,3) + i3_u = UBOUND(SrcMiscData%SpanAngleLE,3) + IF (.NOT. ALLOCATED(DstMiscData%SpanAngleLE)) THEN + ALLOCATE(DstMiscData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE +ENDIF +IF (ALLOCATED(SrcMiscData%rTEtoObserve)) THEN + i1_l = LBOUND(SrcMiscData%rTEtoObserve,1) + i1_u = UBOUND(SrcMiscData%rTEtoObserve,1) + i2_l = LBOUND(SrcMiscData%rTEtoObserve,2) + i2_u = UBOUND(SrcMiscData%rTEtoObserve,2) + i3_l = LBOUND(SrcMiscData%rTEtoObserve,3) + i3_u = UBOUND(SrcMiscData%rTEtoObserve,3) + IF (.NOT. ALLOCATED(DstMiscData%rTEtoObserve)) THEN + ALLOCATE(DstMiscData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve +ENDIF +IF (ALLOCATED(SrcMiscData%rLEtoObserve)) THEN + i1_l = LBOUND(SrcMiscData%rLEtoObserve,1) + i1_u = UBOUND(SrcMiscData%rLEtoObserve,1) + i2_l = LBOUND(SrcMiscData%rLEtoObserve,2) + i2_u = UBOUND(SrcMiscData%rLEtoObserve,2) + i3_l = LBOUND(SrcMiscData%rLEtoObserve,3) + i3_u = UBOUND(SrcMiscData%rLEtoObserve,3) + IF (.NOT. ALLOCATED(DstMiscData%rLEtoObserve)) THEN + ALLOCATE(DstMiscData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve +ENDIF +IF (ALLOCATED(SrcMiscData%LE_Location)) THEN + i1_l = LBOUND(SrcMiscData%LE_Location,1) + i1_u = UBOUND(SrcMiscData%LE_Location,1) + i2_l = LBOUND(SrcMiscData%LE_Location,2) + i2_u = UBOUND(SrcMiscData%LE_Location,2) + i3_l = LBOUND(SrcMiscData%LE_Location,3) + i3_u = UBOUND(SrcMiscData%LE_Location,3) + IF (.NOT. ALLOCATED(DstMiscData%LE_Location)) THEN + ALLOCATE(DstMiscData%LE_Location(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%LE_Location = SrcMiscData%LE_Location +ENDIF + DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA +IF (ALLOCATED(SrcMiscData%SPLLBL)) THEN + i1_l = LBOUND(SrcMiscData%SPLLBL,1) + i1_u = UBOUND(SrcMiscData%SPLLBL,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLLBL)) THEN + ALLOCATE(DstMiscData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLLBL = SrcMiscData%SPLLBL +ENDIF +IF (ALLOCATED(SrcMiscData%SPLP)) THEN + i1_l = LBOUND(SrcMiscData%SPLP,1) + i1_u = UBOUND(SrcMiscData%SPLP,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLP)) THEN + ALLOCATE(DstMiscData%SPLP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLP = SrcMiscData%SPLP +ENDIF +IF (ALLOCATED(SrcMiscData%SPLS)) THEN + i1_l = LBOUND(SrcMiscData%SPLS,1) + i1_u = UBOUND(SrcMiscData%SPLS,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLS)) THEN + ALLOCATE(DstMiscData%SPLS(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLS = SrcMiscData%SPLS +ENDIF +IF (ALLOCATED(SrcMiscData%SPLALPH)) THEN + i1_l = LBOUND(SrcMiscData%SPLALPH,1) + i1_u = UBOUND(SrcMiscData%SPLALPH,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLALPH)) THEN + ALLOCATE(DstMiscData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLALPH = SrcMiscData%SPLALPH +ENDIF +IF (ALLOCATED(SrcMiscData%SPLTBL)) THEN + i1_l = LBOUND(SrcMiscData%SPLTBL,1) + i1_u = UBOUND(SrcMiscData%SPLTBL,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLTBL)) THEN + ALLOCATE(DstMiscData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLTBL = SrcMiscData%SPLTBL +ENDIF +IF (ALLOCATED(SrcMiscData%SPLTIP)) THEN + i1_l = LBOUND(SrcMiscData%SPLTIP,1) + i1_u = UBOUND(SrcMiscData%SPLTIP,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLTIP)) THEN + ALLOCATE(DstMiscData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLTIP = SrcMiscData%SPLTIP +ENDIF +IF (ALLOCATED(SrcMiscData%SPLTI)) THEN + i1_l = LBOUND(SrcMiscData%SPLTI,1) + i1_u = UBOUND(SrcMiscData%SPLTI,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLTI)) THEN + ALLOCATE(DstMiscData%SPLTI(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLTI = SrcMiscData%SPLTI +ENDIF +IF (ALLOCATED(SrcMiscData%SPLTIGui)) THEN + i1_l = LBOUND(SrcMiscData%SPLTIGui,1) + i1_u = UBOUND(SrcMiscData%SPLTIGui,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLTIGui)) THEN + ALLOCATE(DstMiscData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui +ENDIF +IF (ALLOCATED(SrcMiscData%SPLBLUNT)) THEN + i1_l = LBOUND(SrcMiscData%SPLBLUNT,1) + i1_u = UBOUND(SrcMiscData%SPLBLUNT,1) + IF (.NOT. ALLOCATED(DstMiscData%SPLBLUNT)) THEN + ALLOCATE(DstMiscData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT +ENDIF +IF (ALLOCATED(SrcMiscData%CfVar)) THEN + i1_l = LBOUND(SrcMiscData%CfVar,1) + i1_u = UBOUND(SrcMiscData%CfVar,1) + IF (.NOT. ALLOCATED(DstMiscData%CfVar)) THEN + ALLOCATE(DstMiscData%CfVar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CfVar = SrcMiscData%CfVar +ENDIF +IF (ALLOCATED(SrcMiscData%d99Var)) THEN + i1_l = LBOUND(SrcMiscData%d99Var,1) + i1_u = UBOUND(SrcMiscData%d99Var,1) + IF (.NOT. ALLOCATED(DstMiscData%d99Var)) THEN + ALLOCATE(DstMiscData%d99Var(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%d99Var = SrcMiscData%d99Var +ENDIF +IF (ALLOCATED(SrcMiscData%dStarVar)) THEN + i1_l = LBOUND(SrcMiscData%dStarVar,1) + i1_u = UBOUND(SrcMiscData%dStarVar,1) + IF (.NOT. ALLOCATED(DstMiscData%dStarVar)) THEN + ALLOCATE(DstMiscData%dStarVar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%dStarVar = SrcMiscData%dStarVar +ENDIF +IF (ALLOCATED(SrcMiscData%EdgeVelVar)) THEN + i1_l = LBOUND(SrcMiscData%EdgeVelVar,1) + i1_u = UBOUND(SrcMiscData%EdgeVelVar,1) + IF (.NOT. ALLOCATED(DstMiscData%EdgeVelVar)) THEN + ALLOCATE(DstMiscData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar +ENDIF + DstMiscData%speccou = SrcMiscData%speccou + DstMiscData%filesopen = SrcMiscData%filesopen + END SUBROUTINE AA_CopyMisc + + SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(AA_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscData%AllOuts)) THEN + DEALLOCATE(MiscData%AllOuts) +ENDIF +IF (ALLOCATED(MiscData%ChordAngleTE)) THEN + DEALLOCATE(MiscData%ChordAngleTE) +ENDIF +IF (ALLOCATED(MiscData%SpanAngleTE)) THEN + DEALLOCATE(MiscData%SpanAngleTE) +ENDIF +IF (ALLOCATED(MiscData%ChordAngleLE)) THEN + DEALLOCATE(MiscData%ChordAngleLE) +ENDIF +IF (ALLOCATED(MiscData%SpanAngleLE)) THEN + DEALLOCATE(MiscData%SpanAngleLE) +ENDIF +IF (ALLOCATED(MiscData%rTEtoObserve)) THEN + DEALLOCATE(MiscData%rTEtoObserve) +ENDIF +IF (ALLOCATED(MiscData%rLEtoObserve)) THEN + DEALLOCATE(MiscData%rLEtoObserve) +ENDIF +IF (ALLOCATED(MiscData%LE_Location)) THEN + DEALLOCATE(MiscData%LE_Location) +ENDIF +IF (ALLOCATED(MiscData%SPLLBL)) THEN + DEALLOCATE(MiscData%SPLLBL) +ENDIF +IF (ALLOCATED(MiscData%SPLP)) THEN + DEALLOCATE(MiscData%SPLP) +ENDIF +IF (ALLOCATED(MiscData%SPLS)) THEN + DEALLOCATE(MiscData%SPLS) +ENDIF +IF (ALLOCATED(MiscData%SPLALPH)) THEN + DEALLOCATE(MiscData%SPLALPH) +ENDIF +IF (ALLOCATED(MiscData%SPLTBL)) THEN + DEALLOCATE(MiscData%SPLTBL) +ENDIF +IF (ALLOCATED(MiscData%SPLTIP)) THEN + DEALLOCATE(MiscData%SPLTIP) +ENDIF +IF (ALLOCATED(MiscData%SPLTI)) THEN + DEALLOCATE(MiscData%SPLTI) +ENDIF +IF (ALLOCATED(MiscData%SPLTIGui)) THEN + DEALLOCATE(MiscData%SPLTIGui) +ENDIF +IF (ALLOCATED(MiscData%SPLBLUNT)) THEN + DEALLOCATE(MiscData%SPLBLUNT) +ENDIF +IF (ALLOCATED(MiscData%CfVar)) THEN + DEALLOCATE(MiscData%CfVar) +ENDIF +IF (ALLOCATED(MiscData%d99Var)) THEN + DEALLOCATE(MiscData%d99Var) +ENDIF +IF (ALLOCATED(MiscData%dStarVar)) THEN + DEALLOCATE(MiscData%dStarVar) +ENDIF +IF (ALLOCATED(MiscData%EdgeVelVar)) THEN + DEALLOCATE(MiscData%EdgeVelVar) +ENDIF + END SUBROUTINE AA_DestroyMisc + + SUBROUTINE AA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no + IF ( ALLOCATED(InData%AllOuts) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts + END IF + Int_BufSz = Int_BufSz + 1 ! ChordAngleTE allocated yes/no + IF ( ALLOCATED(InData%ChordAngleTE) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! ChordAngleTE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleTE) ! ChordAngleTE + END IF + Int_BufSz = Int_BufSz + 1 ! SpanAngleTE allocated yes/no + IF ( ALLOCATED(InData%SpanAngleTE) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! SpanAngleTE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleTE) ! SpanAngleTE + END IF + Int_BufSz = Int_BufSz + 1 ! ChordAngleLE allocated yes/no + IF ( ALLOCATED(InData%ChordAngleLE) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! ChordAngleLE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleLE) ! ChordAngleLE + END IF + Int_BufSz = Int_BufSz + 1 ! SpanAngleLE allocated yes/no + IF ( ALLOCATED(InData%SpanAngleLE) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! SpanAngleLE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleLE) ! SpanAngleLE + END IF + Int_BufSz = Int_BufSz + 1 ! rTEtoObserve allocated yes/no + IF ( ALLOCATED(InData%rTEtoObserve) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! rTEtoObserve upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rTEtoObserve) ! rTEtoObserve + END IF + Int_BufSz = Int_BufSz + 1 ! rLEtoObserve allocated yes/no + IF ( ALLOCATED(InData%rLEtoObserve) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! rLEtoObserve upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rLEtoObserve) ! rLEtoObserve + END IF + Int_BufSz = Int_BufSz + 1 ! LE_Location allocated yes/no + IF ( ALLOCATED(InData%LE_Location) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! LE_Location upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%LE_Location) ! LE_Location + END IF + Re_BufSz = Re_BufSz + 1 ! RotSpeedAoA + Int_BufSz = Int_BufSz + 1 ! SPLLBL allocated yes/no + IF ( ALLOCATED(InData%SPLLBL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLLBL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLLBL) ! SPLLBL + END IF + Int_BufSz = Int_BufSz + 1 ! SPLP allocated yes/no + IF ( ALLOCATED(InData%SPLP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLP) ! SPLP + END IF + Int_BufSz = Int_BufSz + 1 ! SPLS allocated yes/no + IF ( ALLOCATED(InData%SPLS) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLS) ! SPLS + END IF + Int_BufSz = Int_BufSz + 1 ! SPLALPH allocated yes/no + IF ( ALLOCATED(InData%SPLALPH) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLALPH upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLALPH) ! SPLALPH + END IF + Int_BufSz = Int_BufSz + 1 ! SPLTBL allocated yes/no + IF ( ALLOCATED(InData%SPLTBL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLTBL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLTBL) ! SPLTBL + END IF + Int_BufSz = Int_BufSz + 1 ! SPLTIP allocated yes/no + IF ( ALLOCATED(InData%SPLTIP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLTIP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLTIP) ! SPLTIP + END IF + Int_BufSz = Int_BufSz + 1 ! SPLTI allocated yes/no + IF ( ALLOCATED(InData%SPLTI) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLTI upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLTI) ! SPLTI + END IF + Int_BufSz = Int_BufSz + 1 ! SPLTIGui allocated yes/no + IF ( ALLOCATED(InData%SPLTIGui) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLTIGui upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLTIGui) ! SPLTIGui + END IF + Int_BufSz = Int_BufSz + 1 ! SPLBLUNT allocated yes/no + IF ( ALLOCATED(InData%SPLBLUNT) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SPLBLUNT upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SPLBLUNT) ! SPLBLUNT + END IF + Int_BufSz = Int_BufSz + 1 ! CfVar allocated yes/no + IF ( ALLOCATED(InData%CfVar) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CfVar upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CfVar) ! CfVar + END IF + Int_BufSz = Int_BufSz + 1 ! d99Var allocated yes/no + IF ( ALLOCATED(InData%d99Var) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! d99Var upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%d99Var) ! d99Var + END IF + Int_BufSz = Int_BufSz + 1 ! dStarVar allocated yes/no + IF ( ALLOCATED(InData%dStarVar) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dStarVar upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%dStarVar) ! dStarVar + END IF + Int_BufSz = Int_BufSz + 1 ! EdgeVelVar allocated yes/no + IF ( ALLOCATED(InData%EdgeVelVar) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! EdgeVelVar upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelVar) ! EdgeVelVar + END IF + Int_BufSz = Int_BufSz + 1 ! speccou + Int_BufSz = Int_BufSz + 1 ! filesopen + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ChordAngleTE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%ChordAngleTE,3), UBOUND(InData%ChordAngleTE,3) + DO i2 = LBOUND(InData%ChordAngleTE,2), UBOUND(InData%ChordAngleTE,2) + DO i1 = LBOUND(InData%ChordAngleTE,1), UBOUND(InData%ChordAngleTE,1) + ReKiBuf(Re_Xferred) = InData%ChordAngleTE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SpanAngleTE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%SpanAngleTE,3), UBOUND(InData%SpanAngleTE,3) + DO i2 = LBOUND(InData%SpanAngleTE,2), UBOUND(InData%SpanAngleTE,2) + DO i1 = LBOUND(InData%SpanAngleTE,1), UBOUND(InData%SpanAngleTE,1) + ReKiBuf(Re_Xferred) = InData%SpanAngleTE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ChordAngleLE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%ChordAngleLE,3), UBOUND(InData%ChordAngleLE,3) + DO i2 = LBOUND(InData%ChordAngleLE,2), UBOUND(InData%ChordAngleLE,2) + DO i1 = LBOUND(InData%ChordAngleLE,1), UBOUND(InData%ChordAngleLE,1) + ReKiBuf(Re_Xferred) = InData%ChordAngleLE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SpanAngleLE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%SpanAngleLE,3), UBOUND(InData%SpanAngleLE,3) + DO i2 = LBOUND(InData%SpanAngleLE,2), UBOUND(InData%SpanAngleLE,2) + DO i1 = LBOUND(InData%SpanAngleLE,1), UBOUND(InData%SpanAngleLE,1) + ReKiBuf(Re_Xferred) = InData%SpanAngleLE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%rTEtoObserve) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%rTEtoObserve,3), UBOUND(InData%rTEtoObserve,3) + DO i2 = LBOUND(InData%rTEtoObserve,2), UBOUND(InData%rTEtoObserve,2) + DO i1 = LBOUND(InData%rTEtoObserve,1), UBOUND(InData%rTEtoObserve,1) + ReKiBuf(Re_Xferred) = InData%rTEtoObserve(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%rLEtoObserve) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%rLEtoObserve,3), UBOUND(InData%rLEtoObserve,3) + DO i2 = LBOUND(InData%rLEtoObserve,2), UBOUND(InData%rLEtoObserve,2) + DO i1 = LBOUND(InData%rLEtoObserve,1), UBOUND(InData%rLEtoObserve,1) + ReKiBuf(Re_Xferred) = InData%rLEtoObserve(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LE_Location) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%LE_Location,3), UBOUND(InData%LE_Location,3) + DO i2 = LBOUND(InData%LE_Location,2), UBOUND(InData%LE_Location,2) + DO i1 = LBOUND(InData%LE_Location,1), UBOUND(InData%LE_Location,1) + ReKiBuf(Re_Xferred) = InData%LE_Location(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%RotSpeedAoA + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%SPLLBL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLLBL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLLBL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLLBL,1), UBOUND(InData%SPLLBL,1) + ReKiBuf(Re_Xferred) = InData%SPLLBL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLP,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLP,1), UBOUND(InData%SPLP,1) + ReKiBuf(Re_Xferred) = InData%SPLP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLS,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLS,1), UBOUND(InData%SPLS,1) + ReKiBuf(Re_Xferred) = InData%SPLS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLALPH) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLALPH,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLALPH,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLALPH,1), UBOUND(InData%SPLALPH,1) + ReKiBuf(Re_Xferred) = InData%SPLALPH(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLTBL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTBL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTBL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLTBL,1), UBOUND(InData%SPLTBL,1) + ReKiBuf(Re_Xferred) = InData%SPLTBL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLTIP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTIP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIP,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLTIP,1), UBOUND(InData%SPLTIP,1) + ReKiBuf(Re_Xferred) = InData%SPLTIP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLTI) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTI,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTI,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLTI,1), UBOUND(InData%SPLTI,1) + ReKiBuf(Re_Xferred) = InData%SPLTI(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLTIGui) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTIGui,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIGui,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLTIGui,1), UBOUND(InData%SPLTIGui,1) + ReKiBuf(Re_Xferred) = InData%SPLTIGui(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SPLBLUNT) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLBLUNT,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLBLUNT,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SPLBLUNT,1), UBOUND(InData%SPLBLUNT,1) + ReKiBuf(Re_Xferred) = InData%SPLBLUNT(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CfVar) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfVar,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfVar,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CfVar,1), UBOUND(InData%CfVar,1) + ReKiBuf(Re_Xferred) = InData%CfVar(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%d99Var) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99Var,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99Var,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%d99Var,1), UBOUND(InData%d99Var,1) + ReKiBuf(Re_Xferred) = InData%d99Var(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dStarVar) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarVar,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarVar,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%dStarVar,1), UBOUND(InData%dStarVar,1) + ReKiBuf(Re_Xferred) = InData%dStarVar(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%EdgeVelVar) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelVar,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelVar,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%EdgeVelVar,1), UBOUND(InData%EdgeVelVar,1) + ReKiBuf(Re_Xferred) = InData%EdgeVelVar(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%speccou + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%filesopen + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE AA_PackMisc + + SUBROUTINE AA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) + ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleTE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ChordAngleTE)) DEALLOCATE(OutData%ChordAngleTE) + ALLOCATE(OutData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%ChordAngleTE,3), UBOUND(OutData%ChordAngleTE,3) + DO i2 = LBOUND(OutData%ChordAngleTE,2), UBOUND(OutData%ChordAngleTE,2) + DO i1 = LBOUND(OutData%ChordAngleTE,1), UBOUND(OutData%ChordAngleTE,1) + OutData%ChordAngleTE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleTE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SpanAngleTE)) DEALLOCATE(OutData%SpanAngleTE) + ALLOCATE(OutData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%SpanAngleTE,3), UBOUND(OutData%SpanAngleTE,3) + DO i2 = LBOUND(OutData%SpanAngleTE,2), UBOUND(OutData%SpanAngleTE,2) + DO i1 = LBOUND(OutData%SpanAngleTE,1), UBOUND(OutData%SpanAngleTE,1) + OutData%SpanAngleTE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleLE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ChordAngleLE)) DEALLOCATE(OutData%ChordAngleLE) + ALLOCATE(OutData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%ChordAngleLE,3), UBOUND(OutData%ChordAngleLE,3) + DO i2 = LBOUND(OutData%ChordAngleLE,2), UBOUND(OutData%ChordAngleLE,2) + DO i1 = LBOUND(OutData%ChordAngleLE,1), UBOUND(OutData%ChordAngleLE,1) + OutData%ChordAngleLE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleLE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SpanAngleLE)) DEALLOCATE(OutData%SpanAngleLE) + ALLOCATE(OutData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%SpanAngleLE,3), UBOUND(OutData%SpanAngleLE,3) + DO i2 = LBOUND(OutData%SpanAngleLE,2), UBOUND(OutData%SpanAngleLE,2) + DO i1 = LBOUND(OutData%SpanAngleLE,1), UBOUND(OutData%SpanAngleLE,1) + OutData%SpanAngleLE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTEtoObserve not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rTEtoObserve)) DEALLOCATE(OutData%rTEtoObserve) + ALLOCATE(OutData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%rTEtoObserve,3), UBOUND(OutData%rTEtoObserve,3) + DO i2 = LBOUND(OutData%rTEtoObserve,2), UBOUND(OutData%rTEtoObserve,2) + DO i1 = LBOUND(OutData%rTEtoObserve,1), UBOUND(OutData%rTEtoObserve,1) + OutData%rTEtoObserve(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLEtoObserve not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rLEtoObserve)) DEALLOCATE(OutData%rLEtoObserve) + ALLOCATE(OutData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%rLEtoObserve,3), UBOUND(OutData%rLEtoObserve,3) + DO i2 = LBOUND(OutData%rLEtoObserve,2), UBOUND(OutData%rLEtoObserve,2) + DO i1 = LBOUND(OutData%rLEtoObserve,1), UBOUND(OutData%rLEtoObserve,1) + OutData%rLEtoObserve(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE_Location not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LE_Location)) DEALLOCATE(OutData%LE_Location) + ALLOCATE(OutData%LE_Location(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE_Location.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%LE_Location,3), UBOUND(OutData%LE_Location,3) + DO i2 = LBOUND(OutData%LE_Location,2), UBOUND(OutData%LE_Location,2) + DO i1 = LBOUND(OutData%LE_Location,1), UBOUND(OutData%LE_Location,1) + OutData%LE_Location(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%RotSpeedAoA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLLBL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLLBL)) DEALLOCATE(OutData%SPLLBL) + ALLOCATE(OutData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLLBL,1), UBOUND(OutData%SPLLBL,1) + OutData%SPLLBL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLP)) DEALLOCATE(OutData%SPLP) + ALLOCATE(OutData%SPLP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLP,1), UBOUND(OutData%SPLP,1) + OutData%SPLP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLS)) DEALLOCATE(OutData%SPLS) + ALLOCATE(OutData%SPLS(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLS,1), UBOUND(OutData%SPLS,1) + OutData%SPLS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLALPH not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLALPH)) DEALLOCATE(OutData%SPLALPH) + ALLOCATE(OutData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLALPH,1), UBOUND(OutData%SPLALPH,1) + OutData%SPLALPH(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTBL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLTBL)) DEALLOCATE(OutData%SPLTBL) + ALLOCATE(OutData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLTBL,1), UBOUND(OutData%SPLTBL,1) + OutData%SPLTBL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLTIP)) DEALLOCATE(OutData%SPLTIP) + ALLOCATE(OutData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLTIP,1), UBOUND(OutData%SPLTIP,1) + OutData%SPLTIP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTI not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLTI)) DEALLOCATE(OutData%SPLTI) + ALLOCATE(OutData%SPLTI(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLTI,1), UBOUND(OutData%SPLTI,1) + OutData%SPLTI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIGui not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLTIGui)) DEALLOCATE(OutData%SPLTIGui) + ALLOCATE(OutData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLTIGui,1), UBOUND(OutData%SPLTIGui,1) + OutData%SPLTIGui(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLBLUNT not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SPLBLUNT)) DEALLOCATE(OutData%SPLBLUNT) + ALLOCATE(OutData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SPLBLUNT,1), UBOUND(OutData%SPLBLUNT,1) + OutData%SPLBLUNT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfVar not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CfVar)) DEALLOCATE(OutData%CfVar) + ALLOCATE(OutData%CfVar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CfVar,1), UBOUND(OutData%CfVar,1) + OutData%CfVar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99Var not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%d99Var)) DEALLOCATE(OutData%d99Var) + ALLOCATE(OutData%d99Var(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%d99Var,1), UBOUND(OutData%d99Var,1) + OutData%d99Var(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarVar not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dStarVar)) DEALLOCATE(OutData%dStarVar) + ALLOCATE(OutData%dStarVar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%dStarVar,1), UBOUND(OutData%dStarVar,1) + OutData%dStarVar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelVar not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%EdgeVelVar)) DEALLOCATE(OutData%EdgeVelVar) + ALLOCATE(OutData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%EdgeVelVar,1), UBOUND(OutData%EdgeVelVar,1) + OutData%EdgeVelVar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%speccou = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%filesopen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE AA_UnPackMisc + + SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData + TYPE(AA_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%IBLUNT = SrcParamData%IBLUNT + DstParamData%ILAM = SrcParamData%ILAM + DstParamData%ITIP = SrcParamData%ITIP + DstParamData%ITRIP = SrcParamData%ITRIP + DstParamData%ITURB = SrcParamData%ITURB + DstParamData%IInflow = SrcParamData%IInflow + DstParamData%X_BLMethod = SrcParamData%X_BLMethod + DstParamData%TICalcMeth = SrcParamData%TICalcMeth + DstParamData%ROUND = SrcParamData%ROUND + DstParamData%ALPRAT = SrcParamData%ALPRAT + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumBlNds = SrcParamData%NumBlNds + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%HubHeight = SrcParamData%HubHeight + DstParamData%toptip = SrcParamData%toptip + DstParamData%bottip = SrcParamData%bottip +IF (ALLOCATED(SrcParamData%rotorregionlimitsVert)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsVert,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsVert,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsVert)) THEN + ALLOCATE(DstParamData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert +ENDIF +IF (ALLOCATED(SrcParamData%rotorregionlimitsHorz)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsHorz,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsHorz,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsHorz)) THEN + ALLOCATE(DstParamData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz +ENDIF +IF (ALLOCATED(SrcParamData%rotorregionlimitsalph)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsalph,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsalph,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsalph)) THEN + ALLOCATE(DstParamData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph +ENDIF +IF (ALLOCATED(SrcParamData%rotorregionlimitsrad)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsrad,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsrad,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsrad)) THEN + ALLOCATE(DstParamData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad +ENDIF + DstParamData%NrObsLoc = SrcParamData%NrObsLoc + DstParamData%aweightflag = SrcParamData%aweightflag + DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput + DstParamData%AAStart = SrcParamData%AAStart +IF (ALLOCATED(SrcParamData%ObsX)) THEN + i1_l = LBOUND(SrcParamData%ObsX,1) + i1_u = UBOUND(SrcParamData%ObsX,1) + IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN + ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ObsX = SrcParamData%ObsX +ENDIF +IF (ALLOCATED(SrcParamData%ObsY)) THEN + i1_l = LBOUND(SrcParamData%ObsY,1) + i1_u = UBOUND(SrcParamData%ObsY,1) + IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN + ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ObsY = SrcParamData%ObsY +ENDIF +IF (ALLOCATED(SrcParamData%ObsZ)) THEN + i1_l = LBOUND(SrcParamData%ObsZ,1) + i1_u = UBOUND(SrcParamData%ObsZ,1) + IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN + ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ObsZ = SrcParamData%ObsZ +ENDIF +IF (ALLOCATED(SrcParamData%FreqList)) THEN + i1_l = LBOUND(SrcParamData%FreqList,1) + i1_u = UBOUND(SrcParamData%FreqList,1) + IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN + ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%FreqList = SrcParamData%FreqList +ENDIF +IF (ALLOCATED(SrcParamData%Aweight)) THEN + i1_l = LBOUND(SrcParamData%Aweight,1) + i1_u = UBOUND(SrcParamData%Aweight,1) + IF (.NOT. ALLOCATED(DstParamData%Aweight)) THEN + ALLOCATE(DstParamData%Aweight(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Aweight = SrcParamData%Aweight +ENDIF + DstParamData%Fsample = SrcParamData%Fsample + DstParamData%total_sample = SrcParamData%total_sample + DstParamData%total_sampleTI = SrcParamData%total_sampleTI + DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%startnode = SrcParamData%startnode + DstParamData%z0_aa = SrcParamData%z0_aa + DstParamData%dz_turb_in = SrcParamData%dz_turb_in + DstParamData%dy_turb_in = SrcParamData%dy_turb_in +IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN + i1_l = LBOUND(SrcParamData%TI_Grid_In,1) + i1_u = UBOUND(SrcParamData%TI_Grid_In,1) + i2_l = LBOUND(SrcParamData%TI_Grid_In,2) + i2_u = UBOUND(SrcParamData%TI_Grid_In,2) + IF (.NOT. ALLOCATED(DstParamData%TI_Grid_In)) THEN + ALLOCATE(DstParamData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In +ENDIF + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%outFmt = SrcParamData%outFmt + DstParamData%NrOutFile = SrcParamData%NrOutFile + DstParamData%delim = SrcParamData%delim + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE + DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep + DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes + DstParamData%unOutFile = SrcParamData%unOutFile + DstParamData%unOutFile2 = SrcParamData%unOutFile2 + DstParamData%unOutFile3 = SrcParamData%unOutFile3 + DstParamData%unOutFile4 = SrcParamData%unOutFile4 + DstParamData%RootName = SrcParamData%RootName +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%StallStart)) THEN + i1_l = LBOUND(SrcParamData%StallStart,1) + i1_u = UBOUND(SrcParamData%StallStart,1) + i2_l = LBOUND(SrcParamData%StallStart,2) + i2_u = UBOUND(SrcParamData%StallStart,2) + IF (.NOT. ALLOCATED(DstParamData%StallStart)) THEN + ALLOCATE(DstParamData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%StallStart = SrcParamData%StallStart +ENDIF +IF (ALLOCATED(SrcParamData%TEThick)) THEN + i1_l = LBOUND(SrcParamData%TEThick,1) + i1_u = UBOUND(SrcParamData%TEThick,1) + i2_l = LBOUND(SrcParamData%TEThick,2) + i2_u = UBOUND(SrcParamData%TEThick,2) + IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN + ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%TEThick = SrcParamData%TEThick +ENDIF +IF (ALLOCATED(SrcParamData%TEAngle)) THEN + i1_l = LBOUND(SrcParamData%TEAngle,1) + i1_u = UBOUND(SrcParamData%TEAngle,1) + i2_l = LBOUND(SrcParamData%TEAngle,2) + i2_u = UBOUND(SrcParamData%TEAngle,2) + IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN + ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%TEAngle = SrcParamData%TEAngle +ENDIF +IF (ALLOCATED(SrcParamData%AerCent)) THEN + i1_l = LBOUND(SrcParamData%AerCent,1) + i1_u = UBOUND(SrcParamData%AerCent,1) + i2_l = LBOUND(SrcParamData%AerCent,2) + i2_u = UBOUND(SrcParamData%AerCent,2) + i3_l = LBOUND(SrcParamData%AerCent,3) + i3_u = UBOUND(SrcParamData%AerCent,3) + IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN + ALLOCATE(DstParamData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AerCent = SrcParamData%AerCent +ENDIF +IF (ALLOCATED(SrcParamData%BlAFID)) THEN + i1_l = LBOUND(SrcParamData%BlAFID,1) + i1_u = UBOUND(SrcParamData%BlAFID,1) + i2_l = LBOUND(SrcParamData%BlAFID,2) + i2_u = UBOUND(SrcParamData%BlAFID,2) + IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN + ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BlAFID = SrcParamData%BlAFID +ENDIF +IF (ALLOCATED(SrcParamData%AFInfo)) THEN + i1_l = LBOUND(SrcParamData%AFInfo,1) + i1_u = UBOUND(SrcParamData%AFInfo,1) + IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN + ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) + CALL AFI_CopyParam( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%AFLECo)) THEN + i1_l = LBOUND(SrcParamData%AFLECo,1) + i1_u = UBOUND(SrcParamData%AFLECo,1) + i2_l = LBOUND(SrcParamData%AFLECo,2) + i2_u = UBOUND(SrcParamData%AFLECo,2) + i3_l = LBOUND(SrcParamData%AFLECo,3) + i3_u = UBOUND(SrcParamData%AFLECo,3) + IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN + ALLOCATE(DstParamData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AFLECo = SrcParamData%AFLECo +ENDIF +IF (ALLOCATED(SrcParamData%AFTECo)) THEN + i1_l = LBOUND(SrcParamData%AFTECo,1) + i1_u = UBOUND(SrcParamData%AFTECo,1) + i2_l = LBOUND(SrcParamData%AFTECo,2) + i2_u = UBOUND(SrcParamData%AFTECo,2) + i3_l = LBOUND(SrcParamData%AFTECo,3) + i3_u = UBOUND(SrcParamData%AFTECo,3) + IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN + ALLOCATE(DstParamData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AFTECo = SrcParamData%AFTECo +ENDIF +IF (ALLOCATED(SrcParamData%BlSpn)) THEN + i1_l = LBOUND(SrcParamData%BlSpn,1) + i1_u = UBOUND(SrcParamData%BlSpn,1) + i2_l = LBOUND(SrcParamData%BlSpn,2) + i2_u = UBOUND(SrcParamData%BlSpn,2) + IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN + ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BlSpn = SrcParamData%BlSpn +ENDIF +IF (ALLOCATED(SrcParamData%BlChord)) THEN + i1_l = LBOUND(SrcParamData%BlChord,1) + i1_u = UBOUND(SrcParamData%BlChord,1) + i2_l = LBOUND(SrcParamData%BlChord,2) + i2_u = UBOUND(SrcParamData%BlChord,2) + IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN + ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BlChord = SrcParamData%BlChord +ENDIF +IF (ALLOCATED(SrcParamData%ReListBL)) THEN + i1_l = LBOUND(SrcParamData%ReListBL,1) + i1_u = UBOUND(SrcParamData%ReListBL,1) + IF (.NOT. ALLOCATED(DstParamData%ReListBL)) THEN + ALLOCATE(DstParamData%ReListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ReListBL = SrcParamData%ReListBL +ENDIF +IF (ALLOCATED(SrcParamData%AOAListBL)) THEN + i1_l = LBOUND(SrcParamData%AOAListBL,1) + i1_u = UBOUND(SrcParamData%AOAListBL,1) + IF (.NOT. ALLOCATED(DstParamData%AOAListBL)) THEN + ALLOCATE(DstParamData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AOAListBL = SrcParamData%AOAListBL +ENDIF +IF (ALLOCATED(SrcParamData%dStarAll1)) THEN + i1_l = LBOUND(SrcParamData%dStarAll1,1) + i1_u = UBOUND(SrcParamData%dStarAll1,1) + i2_l = LBOUND(SrcParamData%dStarAll1,2) + i2_u = UBOUND(SrcParamData%dStarAll1,2) + i3_l = LBOUND(SrcParamData%dStarAll1,3) + i3_u = UBOUND(SrcParamData%dStarAll1,3) + IF (.NOT. ALLOCATED(DstParamData%dStarAll1)) THEN + ALLOCATE(DstParamData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%dStarAll1 = SrcParamData%dStarAll1 +ENDIF +IF (ALLOCATED(SrcParamData%dStarAll2)) THEN + i1_l = LBOUND(SrcParamData%dStarAll2,1) + i1_u = UBOUND(SrcParamData%dStarAll2,1) + i2_l = LBOUND(SrcParamData%dStarAll2,2) + i2_u = UBOUND(SrcParamData%dStarAll2,2) + i3_l = LBOUND(SrcParamData%dStarAll2,3) + i3_u = UBOUND(SrcParamData%dStarAll2,3) + IF (.NOT. ALLOCATED(DstParamData%dStarAll2)) THEN + ALLOCATE(DstParamData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%dStarAll2 = SrcParamData%dStarAll2 +ENDIF +IF (ALLOCATED(SrcParamData%d99All1)) THEN + i1_l = LBOUND(SrcParamData%d99All1,1) + i1_u = UBOUND(SrcParamData%d99All1,1) + i2_l = LBOUND(SrcParamData%d99All1,2) + i2_u = UBOUND(SrcParamData%d99All1,2) + i3_l = LBOUND(SrcParamData%d99All1,3) + i3_u = UBOUND(SrcParamData%d99All1,3) + IF (.NOT. ALLOCATED(DstParamData%d99All1)) THEN + ALLOCATE(DstParamData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%d99All1 = SrcParamData%d99All1 +ENDIF +IF (ALLOCATED(SrcParamData%d99All2)) THEN + i1_l = LBOUND(SrcParamData%d99All2,1) + i1_u = UBOUND(SrcParamData%d99All2,1) + i2_l = LBOUND(SrcParamData%d99All2,2) + i2_u = UBOUND(SrcParamData%d99All2,2) + i3_l = LBOUND(SrcParamData%d99All2,3) + i3_u = UBOUND(SrcParamData%d99All2,3) + IF (.NOT. ALLOCATED(DstParamData%d99All2)) THEN + ALLOCATE(DstParamData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%d99All2 = SrcParamData%d99All2 +ENDIF +IF (ALLOCATED(SrcParamData%CfAll1)) THEN + i1_l = LBOUND(SrcParamData%CfAll1,1) + i1_u = UBOUND(SrcParamData%CfAll1,1) + i2_l = LBOUND(SrcParamData%CfAll1,2) + i2_u = UBOUND(SrcParamData%CfAll1,2) + i3_l = LBOUND(SrcParamData%CfAll1,3) + i3_u = UBOUND(SrcParamData%CfAll1,3) + IF (.NOT. ALLOCATED(DstParamData%CfAll1)) THEN + ALLOCATE(DstParamData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CfAll1 = SrcParamData%CfAll1 +ENDIF +IF (ALLOCATED(SrcParamData%CfAll2)) THEN + i1_l = LBOUND(SrcParamData%CfAll2,1) + i1_u = UBOUND(SrcParamData%CfAll2,1) + i2_l = LBOUND(SrcParamData%CfAll2,2) + i2_u = UBOUND(SrcParamData%CfAll2,2) + i3_l = LBOUND(SrcParamData%CfAll2,3) + i3_u = UBOUND(SrcParamData%CfAll2,3) + IF (.NOT. ALLOCATED(DstParamData%CfAll2)) THEN + ALLOCATE(DstParamData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CfAll2 = SrcParamData%CfAll2 +ENDIF +IF (ALLOCATED(SrcParamData%EdgeVelRat1)) THEN + i1_l = LBOUND(SrcParamData%EdgeVelRat1,1) + i1_u = UBOUND(SrcParamData%EdgeVelRat1,1) + i2_l = LBOUND(SrcParamData%EdgeVelRat1,2) + i2_u = UBOUND(SrcParamData%EdgeVelRat1,2) + i3_l = LBOUND(SrcParamData%EdgeVelRat1,3) + i3_u = UBOUND(SrcParamData%EdgeVelRat1,3) + IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat1)) THEN + ALLOCATE(DstParamData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 +ENDIF +IF (ALLOCATED(SrcParamData%EdgeVelRat2)) THEN + i1_l = LBOUND(SrcParamData%EdgeVelRat2,1) + i1_u = UBOUND(SrcParamData%EdgeVelRat2,1) + i2_l = LBOUND(SrcParamData%EdgeVelRat2,2) + i2_u = UBOUND(SrcParamData%EdgeVelRat2,2) + i3_l = LBOUND(SrcParamData%EdgeVelRat2,3) + i3_u = UBOUND(SrcParamData%EdgeVelRat2,3) + IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat2)) THEN + ALLOCATE(DstParamData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 +ENDIF +IF (ALLOCATED(SrcParamData%AFThickGuida)) THEN + i1_l = LBOUND(SrcParamData%AFThickGuida,1) + i1_u = UBOUND(SrcParamData%AFThickGuida,1) + i2_l = LBOUND(SrcParamData%AFThickGuida,2) + i2_u = UBOUND(SrcParamData%AFThickGuida,2) + IF (.NOT. ALLOCATED(DstParamData%AFThickGuida)) THEN + ALLOCATE(DstParamData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AFThickGuida = SrcParamData%AFThickGuida +ENDIF + END SUBROUTINE AA_CopyParam + + SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN + DEALLOCATE(ParamData%rotorregionlimitsVert) +ENDIF +IF (ALLOCATED(ParamData%rotorregionlimitsHorz)) THEN + DEALLOCATE(ParamData%rotorregionlimitsHorz) +ENDIF +IF (ALLOCATED(ParamData%rotorregionlimitsalph)) THEN + DEALLOCATE(ParamData%rotorregionlimitsalph) +ENDIF +IF (ALLOCATED(ParamData%rotorregionlimitsrad)) THEN + DEALLOCATE(ParamData%rotorregionlimitsrad) +ENDIF +IF (ALLOCATED(ParamData%ObsX)) THEN + DEALLOCATE(ParamData%ObsX) +ENDIF +IF (ALLOCATED(ParamData%ObsY)) THEN + DEALLOCATE(ParamData%ObsY) +ENDIF +IF (ALLOCATED(ParamData%ObsZ)) THEN + DEALLOCATE(ParamData%ObsZ) +ENDIF +IF (ALLOCATED(ParamData%FreqList)) THEN + DEALLOCATE(ParamData%FreqList) +ENDIF +IF (ALLOCATED(ParamData%Aweight)) THEN + DEALLOCATE(ParamData%Aweight) +ENDIF +IF (ALLOCATED(ParamData%TI_Grid_In)) THEN + DEALLOCATE(ParamData%TI_Grid_In) +ENDIF +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%StallStart)) THEN + DEALLOCATE(ParamData%StallStart) +ENDIF +IF (ALLOCATED(ParamData%TEThick)) THEN + DEALLOCATE(ParamData%TEThick) +ENDIF +IF (ALLOCATED(ParamData%TEAngle)) THEN + DEALLOCATE(ParamData%TEAngle) +ENDIF +IF (ALLOCATED(ParamData%AerCent)) THEN + DEALLOCATE(ParamData%AerCent) +ENDIF +IF (ALLOCATED(ParamData%BlAFID)) THEN + DEALLOCATE(ParamData%BlAFID) +ENDIF +IF (ALLOCATED(ParamData%AFInfo)) THEN +DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) + CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%AFInfo) +ENDIF +IF (ALLOCATED(ParamData%AFLECo)) THEN + DEALLOCATE(ParamData%AFLECo) +ENDIF +IF (ALLOCATED(ParamData%AFTECo)) THEN + DEALLOCATE(ParamData%AFTECo) +ENDIF +IF (ALLOCATED(ParamData%BlSpn)) THEN + DEALLOCATE(ParamData%BlSpn) +ENDIF +IF (ALLOCATED(ParamData%BlChord)) THEN + DEALLOCATE(ParamData%BlChord) +ENDIF +IF (ALLOCATED(ParamData%ReListBL)) THEN + DEALLOCATE(ParamData%ReListBL) +ENDIF +IF (ALLOCATED(ParamData%AOAListBL)) THEN + DEALLOCATE(ParamData%AOAListBL) +ENDIF +IF (ALLOCATED(ParamData%dStarAll1)) THEN + DEALLOCATE(ParamData%dStarAll1) +ENDIF +IF (ALLOCATED(ParamData%dStarAll2)) THEN + DEALLOCATE(ParamData%dStarAll2) +ENDIF +IF (ALLOCATED(ParamData%d99All1)) THEN + DEALLOCATE(ParamData%d99All1) +ENDIF +IF (ALLOCATED(ParamData%d99All2)) THEN + DEALLOCATE(ParamData%d99All2) +ENDIF +IF (ALLOCATED(ParamData%CfAll1)) THEN + DEALLOCATE(ParamData%CfAll1) +ENDIF +IF (ALLOCATED(ParamData%CfAll2)) THEN + DEALLOCATE(ParamData%CfAll2) +ENDIF +IF (ALLOCATED(ParamData%EdgeVelRat1)) THEN + DEALLOCATE(ParamData%EdgeVelRat1) +ENDIF +IF (ALLOCATED(ParamData%EdgeVelRat2)) THEN + DEALLOCATE(ParamData%EdgeVelRat2) +ENDIF +IF (ALLOCATED(ParamData%AFThickGuida)) THEN + DEALLOCATE(ParamData%AFThickGuida) +ENDIF + END SUBROUTINE AA_DestroyParam + + SUBROUTINE AA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT + Int_BufSz = Int_BufSz + 1 ! IBLUNT + Int_BufSz = Int_BufSz + 1 ! ILAM + Int_BufSz = Int_BufSz + 1 ! ITIP + Int_BufSz = Int_BufSz + 1 ! ITRIP + Int_BufSz = Int_BufSz + 1 ! ITURB + Int_BufSz = Int_BufSz + 1 ! IInflow + Int_BufSz = Int_BufSz + 1 ! X_BLMethod + Int_BufSz = Int_BufSz + 1 ! TICalcMeth + Int_BufSz = Int_BufSz + 1 ! ROUND + Re_BufSz = Re_BufSz + 1 ! ALPRAT + Int_BufSz = Int_BufSz + 1 ! NumBlades + Int_BufSz = Int_BufSz + 1 ! NumBlNds + Re_BufSz = Re_BufSz + 1 ! AirDens + Re_BufSz = Re_BufSz + 1 ! KinVisc + Re_BufSz = Re_BufSz + 1 ! SpdSound + Re_BufSz = Re_BufSz + 1 ! HubHeight + Re_BufSz = Re_BufSz + 1 ! toptip + Re_BufSz = Re_BufSz + 1 ! bottip + Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsVert allocated yes/no + IF ( ALLOCATED(InData%rotorregionlimitsVert) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsVert upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsVert) ! rotorregionlimitsVert + END IF + Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsHorz allocated yes/no + IF ( ALLOCATED(InData%rotorregionlimitsHorz) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsHorz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsHorz) ! rotorregionlimitsHorz + END IF + Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsalph allocated yes/no + IF ( ALLOCATED(InData%rotorregionlimitsalph) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsalph upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsalph) ! rotorregionlimitsalph + END IF + Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsrad allocated yes/no + IF ( ALLOCATED(InData%rotorregionlimitsrad) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsrad upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsrad) ! rotorregionlimitsrad + END IF + Int_BufSz = Int_BufSz + 1 ! NrObsLoc + Int_BufSz = Int_BufSz + 1 ! aweightflag + Int_BufSz = Int_BufSz + 1 ! TxtFileOutput + Db_BufSz = Db_BufSz + 1 ! AAStart + Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no + IF ( ALLOCATED(InData%ObsX) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX + END IF + Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no + IF ( ALLOCATED(InData%ObsY) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY + END IF + Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no + IF ( ALLOCATED(InData%ObsZ) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ + END IF + Int_BufSz = Int_BufSz + 1 ! FreqList allocated yes/no + IF ( ALLOCATED(InData%FreqList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FreqList upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%FreqList) ! FreqList + END IF + Int_BufSz = Int_BufSz + 1 ! Aweight allocated yes/no + IF ( ALLOCATED(InData%Aweight) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Aweight upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Aweight) ! Aweight + END IF + Re_BufSz = Re_BufSz + 1 ! Fsample + Int_BufSz = Int_BufSz + 1 ! total_sample + Int_BufSz = Int_BufSz + 1 ! total_sampleTI + Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge + Int_BufSz = Int_BufSz + 1 ! startnode + Re_BufSz = Re_BufSz + 1 ! z0_aa + Re_BufSz = Re_BufSz + 1 ! dz_turb_in + Re_BufSz = Re_BufSz + 1 ! dy_turb_in + Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no + IF ( ALLOCATED(InData%TI_Grid_In) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle + Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt + Int_BufSz = Int_BufSz + 1 ! NrOutFile + Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumOutsForPE + Int_BufSz = Int_BufSz + 1 ! NumOutsForSep + Int_BufSz = Int_BufSz + 1 ! NumOutsForNodes + Int_BufSz = Int_BufSz + 1 ! unOutFile + Int_BufSz = Int_BufSz + 1 ! unOutFile2 + Int_BufSz = Int_BufSz + 1 ! unOutFile3 + Int_BufSz = Int_BufSz + 1 ! unOutFile4 + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no + IF ( ALLOCATED(InData%OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! StallStart allocated yes/no + IF ( ALLOCATED(InData%StallStart) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StallStart upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%StallStart) ! StallStart + END IF + Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no + IF ( ALLOCATED(InData%TEThick) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TEThick upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick + END IF + Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no + IF ( ALLOCATED(InData%TEAngle) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TEAngle upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle + END IF + Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no + IF ( ALLOCATED(InData%AerCent) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! AerCent upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent + END IF + Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no + IF ( ALLOCATED(InData%BlAFID) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID + END IF + Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no + IF ( ALLOCATED(InData%AFInfo) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension + DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) + Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype + CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AFInfo + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AFInfo + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AFInfo + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! AFLECo allocated yes/no + IF ( ALLOCATED(InData%AFLECo) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! AFLECo upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AFLECo) ! AFLECo + END IF + Int_BufSz = Int_BufSz + 1 ! AFTECo allocated yes/no + IF ( ALLOCATED(InData%AFTECo) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! AFTECo upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AFTECo) ! AFTECo + END IF + Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no + IF ( ALLOCATED(InData%BlSpn) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn + END IF + Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no + IF ( ALLOCATED(InData%BlChord) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord + END IF + Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no + IF ( ALLOCATED(InData%ReListBL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL + END IF + Int_BufSz = Int_BufSz + 1 ! AOAListBL allocated yes/no + IF ( ALLOCATED(InData%AOAListBL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AOAListBL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AOAListBL) ! AOAListBL + END IF + Int_BufSz = Int_BufSz + 1 ! dStarAll1 allocated yes/no + IF ( ALLOCATED(InData%dStarAll1) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! dStarAll1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%dStarAll1) ! dStarAll1 + END IF + Int_BufSz = Int_BufSz + 1 ! dStarAll2 allocated yes/no + IF ( ALLOCATED(InData%dStarAll2) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! dStarAll2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%dStarAll2) ! dStarAll2 + END IF + Int_BufSz = Int_BufSz + 1 ! d99All1 allocated yes/no + IF ( ALLOCATED(InData%d99All1) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! d99All1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%d99All1) ! d99All1 + END IF + Int_BufSz = Int_BufSz + 1 ! d99All2 allocated yes/no + IF ( ALLOCATED(InData%d99All2) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! d99All2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%d99All2) ! d99All2 + END IF + Int_BufSz = Int_BufSz + 1 ! CfAll1 allocated yes/no + IF ( ALLOCATED(InData%CfAll1) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! CfAll1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CfAll1) ! CfAll1 + END IF + Int_BufSz = Int_BufSz + 1 ! CfAll2 allocated yes/no + IF ( ALLOCATED(InData%CfAll2) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! CfAll2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CfAll2) ! CfAll2 + END IF + Int_BufSz = Int_BufSz + 1 ! EdgeVelRat1 allocated yes/no + IF ( ALLOCATED(InData%EdgeVelRat1) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat1) ! EdgeVelRat1 + END IF + Int_BufSz = Int_BufSz + 1 ! EdgeVelRat2 allocated yes/no + IF ( ALLOCATED(InData%EdgeVelRat2) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat2) ! EdgeVelRat2 + END IF + Int_BufSz = Int_BufSz + 1 ! AFThickGuida allocated yes/no + IF ( ALLOCATED(InData%AFThickGuida) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AFThickGuida upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AFThickGuida) ! AFThickGuida + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IBLUNT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ILAM + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ITIP + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ITRIP + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ITURB + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IInflow + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%X_BLMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TICalcMeth + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ALPRAT + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%toptip + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%bottip + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%rotorregionlimitsVert) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsVert,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsVert,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%rotorregionlimitsVert,1), UBOUND(InData%rotorregionlimitsVert,1) + ReKiBuf(Re_Xferred) = InData%rotorregionlimitsVert(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%rotorregionlimitsHorz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsHorz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsHorz,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%rotorregionlimitsHorz,1), UBOUND(InData%rotorregionlimitsHorz,1) + ReKiBuf(Re_Xferred) = InData%rotorregionlimitsHorz(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%rotorregionlimitsalph) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsalph,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsalph,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%rotorregionlimitsalph,1), UBOUND(InData%rotorregionlimitsalph,1) + ReKiBuf(Re_Xferred) = InData%rotorregionlimitsalph(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%rotorregionlimitsrad) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsrad,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsrad,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%rotorregionlimitsrad,1), UBOUND(InData%rotorregionlimitsrad,1) + ReKiBuf(Re_Xferred) = InData%rotorregionlimitsrad(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NrObsLoc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TxtFileOutput, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AAStart + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ObsX) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsX,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) + ReKiBuf(Re_Xferred) = InData%ObsX(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ObsY) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsY,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) + ReKiBuf(Re_Xferred) = InData%ObsY(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ObsZ) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsZ,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) + ReKiBuf(Re_Xferred) = InData%ObsZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FreqList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FreqList,1), UBOUND(InData%FreqList,1) + ReKiBuf(Re_Xferred) = InData%FreqList(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Aweight) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Aweight,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aweight,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Aweight,1), UBOUND(InData%Aweight,1) + ReKiBuf(Re_Xferred) = InData%Aweight(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Fsample + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%total_sample + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%total_sampleTI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%startnode + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z0_aa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dz_turb_in + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dy_turb_in + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) + DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) + ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO I = 1, LEN(InData%FTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%outFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NrOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutsForPE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutsForSep + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutsForNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%unOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%unOutFile2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%unOutFile3 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%unOutFile4 + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%StallStart) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%StallStart,2), UBOUND(InData%StallStart,2) + DO i1 = LBOUND(InData%StallStart,1), UBOUND(InData%StallStart,1) + ReKiBuf(Re_Xferred) = InData%StallStart(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TEThick,2), UBOUND(InData%TEThick,2) + DO i1 = LBOUND(InData%TEThick,1), UBOUND(InData%TEThick,1) + ReKiBuf(Re_Xferred) = InData%TEThick(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TEAngle,2), UBOUND(InData%TEAngle,2) + DO i1 = LBOUND(InData%TEAngle,1), UBOUND(InData%TEAngle,1) + ReKiBuf(Re_Xferred) = InData%TEAngle(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%AerCent,3), UBOUND(InData%AerCent,3) + DO i2 = LBOUND(InData%AerCent,2), UBOUND(InData%AerCent,2) + DO i1 = LBOUND(InData%AerCent,1), UBOUND(InData%AerCent,1) + ReKiBuf(Re_Xferred) = InData%AerCent(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) + DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) + IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AFInfo) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFInfo,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) + CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AFLECo) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%AFLECo,3), UBOUND(InData%AFLECo,3) + DO i2 = LBOUND(InData%AFLECo,2), UBOUND(InData%AFLECo,2) + DO i1 = LBOUND(InData%AFLECo,1), UBOUND(InData%AFLECo,1) + ReKiBuf(Re_Xferred) = InData%AFLECo(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AFTECo) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%AFTECo,3), UBOUND(InData%AFTECo,3) + DO i2 = LBOUND(InData%AFTECo,2), UBOUND(InData%AFTECo,2) + DO i1 = LBOUND(InData%AFTECo,1), UBOUND(InData%AFTECo,1) + ReKiBuf(Re_Xferred) = InData%AFTECo(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) + DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) + ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) + DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) + ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ReListBL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) + ReKiBuf(Re_Xferred) = InData%ReListBL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AOAListBL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AOAListBL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOAListBL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AOAListBL,1), UBOUND(InData%AOAListBL,1) + ReKiBuf(Re_Xferred) = InData%AOAListBL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dStarAll1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%dStarAll1,3), UBOUND(InData%dStarAll1,3) + DO i2 = LBOUND(InData%dStarAll1,2), UBOUND(InData%dStarAll1,2) + DO i1 = LBOUND(InData%dStarAll1,1), UBOUND(InData%dStarAll1,1) + ReKiBuf(Re_Xferred) = InData%dStarAll1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dStarAll2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%dStarAll2,3), UBOUND(InData%dStarAll2,3) + DO i2 = LBOUND(InData%dStarAll2,2), UBOUND(InData%dStarAll2,2) + DO i1 = LBOUND(InData%dStarAll2,1), UBOUND(InData%dStarAll2,1) + ReKiBuf(Re_Xferred) = InData%dStarAll2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%d99All1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%d99All1,3), UBOUND(InData%d99All1,3) + DO i2 = LBOUND(InData%d99All1,2), UBOUND(InData%d99All1,2) + DO i1 = LBOUND(InData%d99All1,1), UBOUND(InData%d99All1,1) + ReKiBuf(Re_Xferred) = InData%d99All1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%d99All2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%d99All2,3), UBOUND(InData%d99All2,3) + DO i2 = LBOUND(InData%d99All2,2), UBOUND(InData%d99All2,2) + DO i1 = LBOUND(InData%d99All2,1), UBOUND(InData%d99All2,1) + ReKiBuf(Re_Xferred) = InData%d99All2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CfAll1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%CfAll1,3), UBOUND(InData%CfAll1,3) + DO i2 = LBOUND(InData%CfAll1,2), UBOUND(InData%CfAll1,2) + DO i1 = LBOUND(InData%CfAll1,1), UBOUND(InData%CfAll1,1) + ReKiBuf(Re_Xferred) = InData%CfAll1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CfAll2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%CfAll2,3), UBOUND(InData%CfAll2,3) + DO i2 = LBOUND(InData%CfAll2,2), UBOUND(InData%CfAll2,2) + DO i1 = LBOUND(InData%CfAll2,1), UBOUND(InData%CfAll2,1) + ReKiBuf(Re_Xferred) = InData%CfAll2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%EdgeVelRat1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%EdgeVelRat1,3), UBOUND(InData%EdgeVelRat1,3) + DO i2 = LBOUND(InData%EdgeVelRat1,2), UBOUND(InData%EdgeVelRat1,2) + DO i1 = LBOUND(InData%EdgeVelRat1,1), UBOUND(InData%EdgeVelRat1,1) + ReKiBuf(Re_Xferred) = InData%EdgeVelRat1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%EdgeVelRat2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%EdgeVelRat2,3), UBOUND(InData%EdgeVelRat2,3) + DO i2 = LBOUND(InData%EdgeVelRat2,2), UBOUND(InData%EdgeVelRat2,2) + DO i1 = LBOUND(InData%EdgeVelRat2,1), UBOUND(InData%EdgeVelRat2,1) + ReKiBuf(Re_Xferred) = InData%EdgeVelRat2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AFThickGuida) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AFThickGuida,2), UBOUND(InData%AFThickGuida,2) + DO i1 = LBOUND(InData%AFThickGuida,1), UBOUND(InData%AFThickGuida,1) + ReKiBuf(Re_Xferred) = InData%AFThickGuida(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AA_PackParam + + SUBROUTINE AA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%IBLUNT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ILAM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ITIP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ITRIP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ITURB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%X_BLMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TICalcMeth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) + Int_Xferred = Int_Xferred + 1 + OutData%ALPRAT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%toptip = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%bottip = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsVert not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rotorregionlimitsVert)) DEALLOCATE(OutData%rotorregionlimitsVert) + ALLOCATE(OutData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%rotorregionlimitsVert,1), UBOUND(OutData%rotorregionlimitsVert,1) + OutData%rotorregionlimitsVert(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsHorz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rotorregionlimitsHorz)) DEALLOCATE(OutData%rotorregionlimitsHorz) + ALLOCATE(OutData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%rotorregionlimitsHorz,1), UBOUND(OutData%rotorregionlimitsHorz,1) + OutData%rotorregionlimitsHorz(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsalph not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rotorregionlimitsalph)) DEALLOCATE(OutData%rotorregionlimitsalph) + ALLOCATE(OutData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%rotorregionlimitsalph,1), UBOUND(OutData%rotorregionlimitsalph,1) + OutData%rotorregionlimitsalph(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsrad not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rotorregionlimitsrad)) DEALLOCATE(OutData%rotorregionlimitsrad) + ALLOCATE(OutData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%rotorregionlimitsrad,1), UBOUND(OutData%rotorregionlimitsrad,1) + OutData%rotorregionlimitsrad(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NrObsLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) + Int_Xferred = Int_Xferred + 1 + OutData%TxtFileOutput = TRANSFER(IntKiBuf(Int_Xferred), OutData%TxtFileOutput) + Int_Xferred = Int_Xferred + 1 + OutData%AAStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ObsX)) DEALLOCATE(OutData%ObsX) + ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) + OutData%ObsX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ObsY)) DEALLOCATE(OutData%ObsY) + ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) + OutData%ObsY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ObsZ)) DEALLOCATE(OutData%ObsZ) + ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) + OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FreqList)) DEALLOCATE(OutData%FreqList) + ALLOCATE(OutData%FreqList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FreqList,1), UBOUND(OutData%FreqList,1) + OutData%FreqList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aweight not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Aweight)) DEALLOCATE(OutData%Aweight) + ALLOCATE(OutData%Aweight(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Aweight,1), UBOUND(OutData%Aweight,1) + OutData%Aweight(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Fsample = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%total_sample = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%total_sampleTI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%startnode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%z0_aa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dz_turb_in = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dy_turb_in = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TI_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) + ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) + DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) + OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO I = 1, LEN(OutData%FTitle) + OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%outFmt) + OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NrOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%delim) + OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutsForPE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutsForSep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutsForNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%unOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%unOutFile2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%unOutFile3 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%unOutFile4 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) + ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StallStart not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StallStart)) DEALLOCATE(OutData%StallStart) + ALLOCATE(OutData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StallStart,2), UBOUND(OutData%StallStart,2) + DO i1 = LBOUND(OutData%StallStart,1), UBOUND(OutData%StallStart,1) + OutData%StallStart(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TEThick)) DEALLOCATE(OutData%TEThick) + ALLOCATE(OutData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TEThick,2), UBOUND(OutData%TEThick,2) + DO i1 = LBOUND(OutData%TEThick,1), UBOUND(OutData%TEThick,1) + OutData%TEThick(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TEAngle)) DEALLOCATE(OutData%TEAngle) + ALLOCATE(OutData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TEAngle,2), UBOUND(OutData%TEAngle,2) + DO i1 = LBOUND(OutData%TEAngle,1), UBOUND(OutData%TEAngle,1) + OutData%TEAngle(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AerCent)) DEALLOCATE(OutData%AerCent) + ALLOCATE(OutData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%AerCent,3), UBOUND(OutData%AerCent,3) + DO i2 = LBOUND(OutData%AerCent,2), UBOUND(OutData%AerCent,2) + DO i1 = LBOUND(OutData%AerCent,1), UBOUND(OutData%AerCent,1) + OutData%AerCent(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlAFID)) DEALLOCATE(OutData%BlAFID) + ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) + DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) + OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFInfo)) DEALLOCATE(OutData%AFInfo) + ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFLECo not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFLECo)) DEALLOCATE(OutData%AFLECo) + ALLOCATE(OutData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFLECo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%AFLECo,3), UBOUND(OutData%AFLECo,3) + DO i2 = LBOUND(OutData%AFLECo,2), UBOUND(OutData%AFLECo,2) + DO i1 = LBOUND(OutData%AFLECo,1), UBOUND(OutData%AFLECo,1) + OutData%AFLECo(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFTECo not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFTECo)) DEALLOCATE(OutData%AFTECo) + ALLOCATE(OutData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFTECo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%AFTECo,3), UBOUND(OutData%AFTECo,3) + DO i2 = LBOUND(OutData%AFTECo,2), UBOUND(OutData%AFTECo,2) + DO i1 = LBOUND(OutData%AFTECo,1), UBOUND(OutData%AFTECo,1) + OutData%AFTECo(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlSpn)) DEALLOCATE(OutData%BlSpn) + ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) + DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) + OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlChord)) DEALLOCATE(OutData%BlChord) + ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) + DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) + OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ReListBL)) DEALLOCATE(OutData%ReListBL) + ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) + OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOAListBL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AOAListBL)) DEALLOCATE(OutData%AOAListBL) + ALLOCATE(OutData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AOAListBL,1), UBOUND(OutData%AOAListBL,1) + OutData%AOAListBL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dStarAll1)) DEALLOCATE(OutData%dStarAll1) + ALLOCATE(OutData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%dStarAll1,3), UBOUND(OutData%dStarAll1,3) + DO i2 = LBOUND(OutData%dStarAll1,2), UBOUND(OutData%dStarAll1,2) + DO i1 = LBOUND(OutData%dStarAll1,1), UBOUND(OutData%dStarAll1,1) + OutData%dStarAll1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dStarAll2)) DEALLOCATE(OutData%dStarAll2) + ALLOCATE(OutData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%dStarAll2,3), UBOUND(OutData%dStarAll2,3) + DO i2 = LBOUND(OutData%dStarAll2,2), UBOUND(OutData%dStarAll2,2) + DO i1 = LBOUND(OutData%dStarAll2,1), UBOUND(OutData%dStarAll2,1) + OutData%dStarAll2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99All1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%d99All1)) DEALLOCATE(OutData%d99All1) + ALLOCATE(OutData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%d99All1,3), UBOUND(OutData%d99All1,3) + DO i2 = LBOUND(OutData%d99All1,2), UBOUND(OutData%d99All1,2) + DO i1 = LBOUND(OutData%d99All1,1), UBOUND(OutData%d99All1,1) + OutData%d99All1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99All2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%d99All2)) DEALLOCATE(OutData%d99All2) + ALLOCATE(OutData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%d99All2,3), UBOUND(OutData%d99All2,3) + DO i2 = LBOUND(OutData%d99All2,2), UBOUND(OutData%d99All2,2) + DO i1 = LBOUND(OutData%d99All2,1), UBOUND(OutData%d99All2,1) + OutData%d99All2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfAll1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CfAll1)) DEALLOCATE(OutData%CfAll1) + ALLOCATE(OutData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%CfAll1,3), UBOUND(OutData%CfAll1,3) + DO i2 = LBOUND(OutData%CfAll1,2), UBOUND(OutData%CfAll1,2) + DO i1 = LBOUND(OutData%CfAll1,1), UBOUND(OutData%CfAll1,1) + OutData%CfAll1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfAll2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CfAll2)) DEALLOCATE(OutData%CfAll2) + ALLOCATE(OutData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%CfAll2,3), UBOUND(OutData%CfAll2,3) + DO i2 = LBOUND(OutData%CfAll2,2), UBOUND(OutData%CfAll2,2) + DO i1 = LBOUND(OutData%CfAll2,1), UBOUND(OutData%CfAll2,1) + OutData%CfAll2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelRat1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%EdgeVelRat1)) DEALLOCATE(OutData%EdgeVelRat1) + ALLOCATE(OutData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%EdgeVelRat1,3), UBOUND(OutData%EdgeVelRat1,3) + DO i2 = LBOUND(OutData%EdgeVelRat1,2), UBOUND(OutData%EdgeVelRat1,2) + DO i1 = LBOUND(OutData%EdgeVelRat1,1), UBOUND(OutData%EdgeVelRat1,1) + OutData%EdgeVelRat1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelRat2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%EdgeVelRat2)) DEALLOCATE(OutData%EdgeVelRat2) + ALLOCATE(OutData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%EdgeVelRat2,3), UBOUND(OutData%EdgeVelRat2,3) + DO i2 = LBOUND(OutData%EdgeVelRat2,2), UBOUND(OutData%EdgeVelRat2,2) + DO i1 = LBOUND(OutData%EdgeVelRat2,1), UBOUND(OutData%EdgeVelRat2,1) + OutData%EdgeVelRat2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFThickGuida not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFThickGuida)) DEALLOCATE(OutData%AFThickGuida) + ALLOCATE(OutData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AFThickGuida,2), UBOUND(OutData%AFThickGuida,2) + DO i1 = LBOUND(OutData%AFThickGuida,1), UBOUND(OutData%AFThickGuida,1) + OutData%AFThickGuida(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AA_UnPackParam + + SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_InputType), INTENT(IN) :: SrcInputData + TYPE(AA_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInputData%RotGtoL)) THEN + i1_l = LBOUND(SrcInputData%RotGtoL,1) + i1_u = UBOUND(SrcInputData%RotGtoL,1) + i2_l = LBOUND(SrcInputData%RotGtoL,2) + i2_u = UBOUND(SrcInputData%RotGtoL,2) + i3_l = LBOUND(SrcInputData%RotGtoL,3) + i3_u = UBOUND(SrcInputData%RotGtoL,3) + i4_l = LBOUND(SrcInputData%RotGtoL,4) + i4_u = UBOUND(SrcInputData%RotGtoL,4) + IF (.NOT. ALLOCATED(DstInputData%RotGtoL)) THEN + ALLOCATE(DstInputData%RotGtoL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%RotGtoL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%RotGtoL = SrcInputData%RotGtoL +ENDIF +IF (ALLOCATED(SrcInputData%AeroCent_G)) THEN + i1_l = LBOUND(SrcInputData%AeroCent_G,1) + i1_u = UBOUND(SrcInputData%AeroCent_G,1) + i2_l = LBOUND(SrcInputData%AeroCent_G,2) + i2_u = UBOUND(SrcInputData%AeroCent_G,2) + i3_l = LBOUND(SrcInputData%AeroCent_G,3) + i3_u = UBOUND(SrcInputData%AeroCent_G,3) + IF (.NOT. ALLOCATED(DstInputData%AeroCent_G)) THEN + ALLOCATE(DstInputData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%AeroCent_G = SrcInputData%AeroCent_G +ENDIF +IF (ALLOCATED(SrcInputData%Vrel)) THEN + i1_l = LBOUND(SrcInputData%Vrel,1) + i1_u = UBOUND(SrcInputData%Vrel,1) + i2_l = LBOUND(SrcInputData%Vrel,2) + i2_u = UBOUND(SrcInputData%Vrel,2) + IF (.NOT. ALLOCATED(DstInputData%Vrel)) THEN + ALLOCATE(DstInputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%Vrel = SrcInputData%Vrel +ENDIF +IF (ALLOCATED(SrcInputData%AoANoise)) THEN + i1_l = LBOUND(SrcInputData%AoANoise,1) + i1_u = UBOUND(SrcInputData%AoANoise,1) + i2_l = LBOUND(SrcInputData%AoANoise,2) + i2_u = UBOUND(SrcInputData%AoANoise,2) + IF (.NOT. ALLOCATED(DstInputData%AoANoise)) THEN + ALLOCATE(DstInputData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%AoANoise = SrcInputData%AoANoise +ENDIF +IF (ALLOCATED(SrcInputData%Inflow)) THEN + i1_l = LBOUND(SrcInputData%Inflow,1) + i1_u = UBOUND(SrcInputData%Inflow,1) + i2_l = LBOUND(SrcInputData%Inflow,2) + i2_u = UBOUND(SrcInputData%Inflow,2) + i3_l = LBOUND(SrcInputData%Inflow,3) + i3_u = UBOUND(SrcInputData%Inflow,3) + IF (.NOT. ALLOCATED(DstInputData%Inflow)) THEN + ALLOCATE(DstInputData%Inflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%Inflow = SrcInputData%Inflow +ENDIF + END SUBROUTINE AA_CopyInput + + SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(AA_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InputData%RotGtoL)) THEN + DEALLOCATE(InputData%RotGtoL) +ENDIF +IF (ALLOCATED(InputData%AeroCent_G)) THEN + DEALLOCATE(InputData%AeroCent_G) +ENDIF +IF (ALLOCATED(InputData%Vrel)) THEN + DEALLOCATE(InputData%Vrel) +ENDIF +IF (ALLOCATED(InputData%AoANoise)) THEN + DEALLOCATE(InputData%AoANoise) +ENDIF +IF (ALLOCATED(InputData%Inflow)) THEN + DEALLOCATE(InputData%Inflow) +ENDIF + END SUBROUTINE AA_DestroyInput + + SUBROUTINE AA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! RotGtoL allocated yes/no + IF ( ALLOCATED(InData%RotGtoL) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! RotGtoL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%RotGtoL) ! RotGtoL + END IF + Int_BufSz = Int_BufSz + 1 ! AeroCent_G allocated yes/no + IF ( ALLOCATED(InData%AeroCent_G) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! AeroCent_G upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AeroCent_G) ! AeroCent_G + END IF + Int_BufSz = Int_BufSz + 1 ! Vrel allocated yes/no + IF ( ALLOCATED(InData%Vrel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel + END IF + Int_BufSz = Int_BufSz + 1 ! AoANoise allocated yes/no + IF ( ALLOCATED(InData%AoANoise) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AoANoise upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AoANoise) ! AoANoise + END IF + Int_BufSz = Int_BufSz + 1 ! Inflow allocated yes/no + IF ( ALLOCATED(InData%Inflow) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Inflow upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Inflow) ! Inflow + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%RotGtoL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%RotGtoL,4), UBOUND(InData%RotGtoL,4) + DO i3 = LBOUND(InData%RotGtoL,3), UBOUND(InData%RotGtoL,3) + DO i2 = LBOUND(InData%RotGtoL,2), UBOUND(InData%RotGtoL,2) + DO i1 = LBOUND(InData%RotGtoL,1), UBOUND(InData%RotGtoL,1) + ReKiBuf(Re_Xferred) = InData%RotGtoL(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AeroCent_G) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%AeroCent_G,3), UBOUND(InData%AeroCent_G,3) + DO i2 = LBOUND(InData%AeroCent_G,2), UBOUND(InData%AeroCent_G,2) + DO i1 = LBOUND(InData%AeroCent_G,1), UBOUND(InData%AeroCent_G,1) + ReKiBuf(Re_Xferred) = InData%AeroCent_G(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vrel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) + DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) + ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AoANoise) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AoANoise,2), UBOUND(InData%AoANoise,2) + DO i1 = LBOUND(InData%AoANoise,1), UBOUND(InData%AoANoise,1) + ReKiBuf(Re_Xferred) = InData%AoANoise(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Inflow) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Inflow,3), UBOUND(InData%Inflow,3) + DO i2 = LBOUND(InData%Inflow,2), UBOUND(InData%Inflow,2) + DO i1 = LBOUND(InData%Inflow,1), UBOUND(InData%Inflow,1) + ReKiBuf(Re_Xferred) = InData%Inflow(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE AA_PackInput + + SUBROUTINE AA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotGtoL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotGtoL)) DEALLOCATE(OutData%RotGtoL) + ALLOCATE(OutData%RotGtoL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotGtoL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%RotGtoL,4), UBOUND(OutData%RotGtoL,4) + DO i3 = LBOUND(OutData%RotGtoL,3), UBOUND(OutData%RotGtoL,3) + DO i2 = LBOUND(OutData%RotGtoL,2), UBOUND(OutData%RotGtoL,2) + DO i1 = LBOUND(OutData%RotGtoL,1), UBOUND(OutData%RotGtoL,1) + OutData%RotGtoL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroCent_G not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AeroCent_G)) DEALLOCATE(OutData%AeroCent_G) + ALLOCATE(OutData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%AeroCent_G,3), UBOUND(OutData%AeroCent_G,3) + DO i2 = LBOUND(OutData%AeroCent_G,2), UBOUND(OutData%AeroCent_G,2) + DO i1 = LBOUND(OutData%AeroCent_G,1), UBOUND(OutData%AeroCent_G,1) + OutData%AeroCent_G(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vrel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vrel)) DEALLOCATE(OutData%Vrel) + ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) + DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) + OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoANoise not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AoANoise)) DEALLOCATE(OutData%AoANoise) + ALLOCATE(OutData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AoANoise,2), UBOUND(OutData%AoANoise,2) + DO i1 = LBOUND(OutData%AoANoise,1), UBOUND(OutData%AoANoise,1) + OutData%AoANoise(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Inflow not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Inflow)) DEALLOCATE(OutData%Inflow) + ALLOCATE(OutData%Inflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Inflow,3), UBOUND(OutData%Inflow,3) + DO i2 = LBOUND(OutData%Inflow,2), UBOUND(OutData%Inflow,2) + DO i1 = LBOUND(OutData%Inflow,1), UBOUND(OutData%Inflow,1) + OutData%Inflow(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE AA_UnPackInput + + SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_OutputType), INTENT(IN) :: SrcOutputData + TYPE(AA_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOutputData%SumSpecNoise)) THEN + i1_l = LBOUND(SrcOutputData%SumSpecNoise,1) + i1_u = UBOUND(SrcOutputData%SumSpecNoise,1) + i2_l = LBOUND(SrcOutputData%SumSpecNoise,2) + i2_u = UBOUND(SrcOutputData%SumSpecNoise,2) + i3_l = LBOUND(SrcOutputData%SumSpecNoise,3) + i3_u = UBOUND(SrcOutputData%SumSpecNoise,3) + IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoise)) THEN + ALLOCATE(DstOutputData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise +ENDIF +IF (ALLOCATED(SrcOutputData%SumSpecNoiseSep)) THEN + i1_l = LBOUND(SrcOutputData%SumSpecNoiseSep,1) + i1_u = UBOUND(SrcOutputData%SumSpecNoiseSep,1) + i2_l = LBOUND(SrcOutputData%SumSpecNoiseSep,2) + i2_u = UBOUND(SrcOutputData%SumSpecNoiseSep,2) + i3_l = LBOUND(SrcOutputData%SumSpecNoiseSep,3) + i3_u = UBOUND(SrcOutputData%SumSpecNoiseSep,3) + IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoiseSep)) THEN + ALLOCATE(DstOutputData%SumSpecNoiseSep(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep +ENDIF +IF (ALLOCATED(SrcOutputData%OASPL)) THEN + i1_l = LBOUND(SrcOutputData%OASPL,1) + i1_u = UBOUND(SrcOutputData%OASPL,1) + i2_l = LBOUND(SrcOutputData%OASPL,2) + i2_u = UBOUND(SrcOutputData%OASPL,2) + i3_l = LBOUND(SrcOutputData%OASPL,3) + i3_u = UBOUND(SrcOutputData%OASPL,3) + IF (.NOT. ALLOCATED(DstOutputData%OASPL)) THEN + ALLOCATE(DstOutputData%OASPL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%OASPL = SrcOutputData%OASPL +ENDIF +IF (ALLOCATED(SrcOutputData%OASPL_Mech)) THEN + i1_l = LBOUND(SrcOutputData%OASPL_Mech,1) + i1_u = UBOUND(SrcOutputData%OASPL_Mech,1) + i2_l = LBOUND(SrcOutputData%OASPL_Mech,2) + i2_u = UBOUND(SrcOutputData%OASPL_Mech,2) + i3_l = LBOUND(SrcOutputData%OASPL_Mech,3) + i3_u = UBOUND(SrcOutputData%OASPL_Mech,3) + i4_l = LBOUND(SrcOutputData%OASPL_Mech,4) + i4_u = UBOUND(SrcOutputData%OASPL_Mech,4) + IF (.NOT. ALLOCATED(DstOutputData%OASPL_Mech)) THEN + ALLOCATE(DstOutputData%OASPL_Mech(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech +ENDIF +IF (ALLOCATED(SrcOutputData%DirectiviOutput)) THEN + i1_l = LBOUND(SrcOutputData%DirectiviOutput,1) + i1_u = UBOUND(SrcOutputData%DirectiviOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%DirectiviOutput)) THEN + ALLOCATE(DstOutputData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput +ENDIF +IF (ALLOCATED(SrcOutputData%OutLECoords)) THEN + i1_l = LBOUND(SrcOutputData%OutLECoords,1) + i1_u = UBOUND(SrcOutputData%OutLECoords,1) + i2_l = LBOUND(SrcOutputData%OutLECoords,2) + i2_u = UBOUND(SrcOutputData%OutLECoords,2) + i3_l = LBOUND(SrcOutputData%OutLECoords,3) + i3_u = UBOUND(SrcOutputData%OutLECoords,3) + i4_l = LBOUND(SrcOutputData%OutLECoords,4) + i4_u = UBOUND(SrcOutputData%OutLECoords,4) + IF (.NOT. ALLOCATED(DstOutputData%OutLECoords)) THEN + ALLOCATE(DstOutputData%OutLECoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutLECoords.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%OutLECoords = SrcOutputData%OutLECoords +ENDIF +IF (ALLOCATED(SrcOutputData%PtotalFreq)) THEN + i1_l = LBOUND(SrcOutputData%PtotalFreq,1) + i1_u = UBOUND(SrcOutputData%PtotalFreq,1) + i2_l = LBOUND(SrcOutputData%PtotalFreq,2) + i2_u = UBOUND(SrcOutputData%PtotalFreq,2) + IF (.NOT. ALLOCATED(DstOutputData%PtotalFreq)) THEN + ALLOCATE(DstOutputData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq +ENDIF +IF (ALLOCATED(SrcOutputData%WriteOutputForPE)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutputForPE,1) + i1_u = UBOUND(SrcOutputData%WriteOutputForPE,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutputForPE)) THEN + ALLOCATE(DstOutputData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE +ENDIF +IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutput,1) + i1_u = UBOUND(SrcOutputData%WriteOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN + ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutput = SrcOutputData%WriteOutput +ENDIF +IF (ALLOCATED(SrcOutputData%WriteOutputSep)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutputSep,1) + i1_u = UBOUND(SrcOutputData%WriteOutputSep,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutputSep)) THEN + ALLOCATE(DstOutputData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep +ENDIF +IF (ALLOCATED(SrcOutputData%WriteOutputNode)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutputNode,1) + i1_u = UBOUND(SrcOutputData%WriteOutputNode,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutputNode)) THEN + ALLOCATE(DstOutputData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode +ENDIF + END SUBROUTINE AA_CopyOutput + + SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(AA_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OutputData%SumSpecNoise)) THEN + DEALLOCATE(OutputData%SumSpecNoise) +ENDIF +IF (ALLOCATED(OutputData%SumSpecNoiseSep)) THEN + DEALLOCATE(OutputData%SumSpecNoiseSep) +ENDIF +IF (ALLOCATED(OutputData%OASPL)) THEN + DEALLOCATE(OutputData%OASPL) +ENDIF +IF (ALLOCATED(OutputData%OASPL_Mech)) THEN + DEALLOCATE(OutputData%OASPL_Mech) +ENDIF +IF (ALLOCATED(OutputData%DirectiviOutput)) THEN + DEALLOCATE(OutputData%DirectiviOutput) +ENDIF +IF (ALLOCATED(OutputData%OutLECoords)) THEN + DEALLOCATE(OutputData%OutLECoords) +ENDIF +IF (ALLOCATED(OutputData%PtotalFreq)) THEN + DEALLOCATE(OutputData%PtotalFreq) +ENDIF +IF (ALLOCATED(OutputData%WriteOutputForPE)) THEN + DEALLOCATE(OutputData%WriteOutputForPE) +ENDIF +IF (ALLOCATED(OutputData%WriteOutput)) THEN + DEALLOCATE(OutputData%WriteOutput) +ENDIF +IF (ALLOCATED(OutputData%WriteOutputSep)) THEN + DEALLOCATE(OutputData%WriteOutputSep) +ENDIF +IF (ALLOCATED(OutputData%WriteOutputNode)) THEN + DEALLOCATE(OutputData%WriteOutputNode) +ENDIF + END SUBROUTINE AA_DestroyOutput + + SUBROUTINE AA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AA_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! SumSpecNoise allocated yes/no + IF ( ALLOCATED(InData%SumSpecNoise) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoise upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoise) ! SumSpecNoise + END IF + Int_BufSz = Int_BufSz + 1 ! SumSpecNoiseSep allocated yes/no + IF ( ALLOCATED(InData%SumSpecNoiseSep) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoiseSep upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoiseSep) ! SumSpecNoiseSep + END IF + Int_BufSz = Int_BufSz + 1 ! OASPL allocated yes/no + IF ( ALLOCATED(InData%OASPL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! OASPL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%OASPL) ! OASPL + END IF + Int_BufSz = Int_BufSz + 1 ! OASPL_Mech allocated yes/no + IF ( ALLOCATED(InData%OASPL_Mech) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! OASPL_Mech upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%OASPL_Mech) ! OASPL_Mech + END IF + Int_BufSz = Int_BufSz + 1 ! DirectiviOutput allocated yes/no + IF ( ALLOCATED(InData%DirectiviOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DirectiviOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%DirectiviOutput) ! DirectiviOutput + END IF + Int_BufSz = Int_BufSz + 1 ! OutLECoords allocated yes/no + IF ( ALLOCATED(InData%OutLECoords) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! OutLECoords upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%OutLECoords) ! OutLECoords + END IF + Int_BufSz = Int_BufSz + 1 ! PtotalFreq allocated yes/no + IF ( ALLOCATED(InData%PtotalFreq) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PtotalFreq upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PtotalFreq) ! PtotalFreq + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputForPE allocated yes/no + IF ( ALLOCATED(InData%WriteOutputForPE) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputForPE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputForPE) ! WriteOutputForPE + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no + IF ( ALLOCATED(InData%WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputSep allocated yes/no + IF ( ALLOCATED(InData%WriteOutputSep) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputSep upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputSep) ! WriteOutputSep + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputNode allocated yes/no + IF ( ALLOCATED(InData%WriteOutputNode) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputNode upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputNode) ! WriteOutputNode + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%SumSpecNoise) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%SumSpecNoise,3), UBOUND(InData%SumSpecNoise,3) + DO i2 = LBOUND(InData%SumSpecNoise,2), UBOUND(InData%SumSpecNoise,2) + DO i1 = LBOUND(InData%SumSpecNoise,1), UBOUND(InData%SumSpecNoise,1) + ReKiBuf(Re_Xferred) = InData%SumSpecNoise(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SumSpecNoiseSep) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%SumSpecNoiseSep,3), UBOUND(InData%SumSpecNoiseSep,3) + DO i2 = LBOUND(InData%SumSpecNoiseSep,2), UBOUND(InData%SumSpecNoiseSep,2) + DO i1 = LBOUND(InData%SumSpecNoiseSep,1), UBOUND(InData%SumSpecNoiseSep,1) + ReKiBuf(Re_Xferred) = InData%SumSpecNoiseSep(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OASPL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%OASPL,3), UBOUND(InData%OASPL,3) + DO i2 = LBOUND(InData%OASPL,2), UBOUND(InData%OASPL,2) + DO i1 = LBOUND(InData%OASPL,1), UBOUND(InData%OASPL,1) + ReKiBuf(Re_Xferred) = InData%OASPL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OASPL_Mech) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%OASPL_Mech,4), UBOUND(InData%OASPL_Mech,4) + DO i3 = LBOUND(InData%OASPL_Mech,3), UBOUND(InData%OASPL_Mech,3) + DO i2 = LBOUND(InData%OASPL_Mech,2), UBOUND(InData%OASPL_Mech,2) + DO i1 = LBOUND(InData%OASPL_Mech,1), UBOUND(InData%OASPL_Mech,1) + ReKiBuf(Re_Xferred) = InData%OASPL_Mech(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DirectiviOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DirectiviOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DirectiviOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DirectiviOutput,1), UBOUND(InData%DirectiviOutput,1) + ReKiBuf(Re_Xferred) = InData%DirectiviOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OutLECoords) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%OutLECoords,4), UBOUND(InData%OutLECoords,4) + DO i3 = LBOUND(InData%OutLECoords,3), UBOUND(InData%OutLECoords,3) + DO i2 = LBOUND(InData%OutLECoords,2), UBOUND(InData%OutLECoords,2) + DO i1 = LBOUND(InData%OutLECoords,1), UBOUND(InData%OutLECoords,1) + ReKiBuf(Re_Xferred) = InData%OutLECoords(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PtotalFreq) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PtotalFreq,2), UBOUND(InData%PtotalFreq,2) + DO i1 = LBOUND(InData%PtotalFreq,1), UBOUND(InData%PtotalFreq,1) + ReKiBuf(Re_Xferred) = InData%PtotalFreq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputForPE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputForPE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputForPE,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputForPE,1), UBOUND(InData%WriteOutputForPE,1) + ReKiBuf(Re_Xferred) = InData%WriteOutputForPE(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputSep) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputSep,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputSep,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputSep,1), UBOUND(InData%WriteOutputSep,1) + ReKiBuf(Re_Xferred) = InData%WriteOutputSep(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputNode) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputNode,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputNode,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputNode,1), UBOUND(InData%WriteOutputNode,1) + ReKiBuf(Re_Xferred) = InData%WriteOutputNode(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AA_PackOutput + + SUBROUTINE AA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AA_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SumSpecNoise not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SumSpecNoise)) DEALLOCATE(OutData%SumSpecNoise) + ALLOCATE(OutData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%SumSpecNoise,3), UBOUND(OutData%SumSpecNoise,3) + DO i2 = LBOUND(OutData%SumSpecNoise,2), UBOUND(OutData%SumSpecNoise,2) + DO i1 = LBOUND(OutData%SumSpecNoise,1), UBOUND(OutData%SumSpecNoise,1) + OutData%SumSpecNoise(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SumSpecNoiseSep not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SumSpecNoiseSep)) DEALLOCATE(OutData%SumSpecNoiseSep) + ALLOCATE(OutData%SumSpecNoiseSep(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%SumSpecNoiseSep,3), UBOUND(OutData%SumSpecNoiseSep,3) + DO i2 = LBOUND(OutData%SumSpecNoiseSep,2), UBOUND(OutData%SumSpecNoiseSep,2) + DO i1 = LBOUND(OutData%SumSpecNoiseSep,1), UBOUND(OutData%SumSpecNoiseSep,1) + OutData%SumSpecNoiseSep(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OASPL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OASPL)) DEALLOCATE(OutData%OASPL) + ALLOCATE(OutData%OASPL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%OASPL,3), UBOUND(OutData%OASPL,3) + DO i2 = LBOUND(OutData%OASPL,2), UBOUND(OutData%OASPL,2) + DO i1 = LBOUND(OutData%OASPL,1), UBOUND(OutData%OASPL,1) + OutData%OASPL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OASPL_Mech not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OASPL_Mech)) DEALLOCATE(OutData%OASPL_Mech) + ALLOCATE(OutData%OASPL_Mech(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%OASPL_Mech,4), UBOUND(OutData%OASPL_Mech,4) + DO i3 = LBOUND(OutData%OASPL_Mech,3), UBOUND(OutData%OASPL_Mech,3) + DO i2 = LBOUND(OutData%OASPL_Mech,2), UBOUND(OutData%OASPL_Mech,2) + DO i1 = LBOUND(OutData%OASPL_Mech,1), UBOUND(OutData%OASPL_Mech,1) + OutData%OASPL_Mech(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DirectiviOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DirectiviOutput)) DEALLOCATE(OutData%DirectiviOutput) + ALLOCATE(OutData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DirectiviOutput,1), UBOUND(OutData%DirectiviOutput,1) + OutData%DirectiviOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutLECoords not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutLECoords)) DEALLOCATE(OutData%OutLECoords) + ALLOCATE(OutData%OutLECoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutLECoords.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%OutLECoords,4), UBOUND(OutData%OutLECoords,4) + DO i3 = LBOUND(OutData%OutLECoords,3), UBOUND(OutData%OutLECoords,3) + DO i2 = LBOUND(OutData%OutLECoords,2), UBOUND(OutData%OutLECoords,2) + DO i1 = LBOUND(OutData%OutLECoords,1), UBOUND(OutData%OutLECoords,1) + OutData%OutLECoords(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtotalFreq not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PtotalFreq)) DEALLOCATE(OutData%PtotalFreq) + ALLOCATE(OutData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PtotalFreq,2), UBOUND(OutData%PtotalFreq,2) + DO i1 = LBOUND(OutData%PtotalFreq,1), UBOUND(OutData%PtotalFreq,1) + OutData%PtotalFreq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputForPE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputForPE)) DEALLOCATE(OutData%WriteOutputForPE) + ALLOCATE(OutData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputForPE,1), UBOUND(OutData%WriteOutputForPE,1) + OutData%WriteOutputForPE(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) + ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputSep not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputSep)) DEALLOCATE(OutData%WriteOutputSep) + ALLOCATE(OutData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputSep,1), UBOUND(OutData%WriteOutputSep,1) + OutData%WriteOutputSep(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputNode not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputNode)) DEALLOCATE(OutData%WriteOutputNode) + ALLOCATE(OutData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputNode,1), UBOUND(OutData%WriteOutputNode,1) + OutData%WriteOutputNode(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE AA_UnPackOutput + + + SUBROUTINE AA_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(AA_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(AA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AA_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL AA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL AA_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL AA_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE AA_Input_ExtrapInterp + + + SUBROUTINE AA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(AA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(AA_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AA_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ALLOCATED(u_out%RotGtoL) .AND. ALLOCATED(u1%RotGtoL)) THEN + DO i4 = LBOUND(u_out%RotGtoL,4),UBOUND(u_out%RotGtoL,4) + DO i3 = LBOUND(u_out%RotGtoL,3),UBOUND(u_out%RotGtoL,3) + DO i2 = LBOUND(u_out%RotGtoL,2),UBOUND(u_out%RotGtoL,2) + DO i1 = LBOUND(u_out%RotGtoL,1),UBOUND(u_out%RotGtoL,1) + b = -(u1%RotGtoL(i1,i2,i3,i4) - u2%RotGtoL(i1,i2,i3,i4)) + u_out%RotGtoL(i1,i2,i3,i4) = u1%RotGtoL(i1,i2,i3,i4) + b * ScaleFactor + END DO + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%AeroCent_G) .AND. ALLOCATED(u1%AeroCent_G)) THEN + DO i3 = LBOUND(u_out%AeroCent_G,3),UBOUND(u_out%AeroCent_G,3) + DO i2 = LBOUND(u_out%AeroCent_G,2),UBOUND(u_out%AeroCent_G,2) + DO i1 = LBOUND(u_out%AeroCent_G,1),UBOUND(u_out%AeroCent_G,1) + b = -(u1%AeroCent_G(i1,i2,i3) - u2%AeroCent_G(i1,i2,i3)) + u_out%AeroCent_G(i1,i2,i3) = u1%AeroCent_G(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%Vrel) .AND. ALLOCATED(u1%Vrel)) THEN + DO i2 = LBOUND(u_out%Vrel,2),UBOUND(u_out%Vrel,2) + DO i1 = LBOUND(u_out%Vrel,1),UBOUND(u_out%Vrel,1) + b = -(u1%Vrel(i1,i2) - u2%Vrel(i1,i2)) + u_out%Vrel(i1,i2) = u1%Vrel(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%AoANoise) .AND. ALLOCATED(u1%AoANoise)) THEN + DO i2 = LBOUND(u_out%AoANoise,2),UBOUND(u_out%AoANoise,2) + DO i1 = LBOUND(u_out%AoANoise,1),UBOUND(u_out%AoANoise,1) + b = -(u1%AoANoise(i1,i2) - u2%AoANoise(i1,i2)) + u_out%AoANoise(i1,i2) = u1%AoANoise(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%Inflow) .AND. ALLOCATED(u1%Inflow)) THEN + DO i3 = LBOUND(u_out%Inflow,3),UBOUND(u_out%Inflow,3) + DO i2 = LBOUND(u_out%Inflow,2),UBOUND(u_out%Inflow,2) + DO i1 = LBOUND(u_out%Inflow,1),UBOUND(u_out%Inflow,1) + b = -(u1%Inflow(i1,i2,i3) - u2%Inflow(i1,i2,i3)) + u_out%Inflow(i1,i2,i3) = u1%Inflow(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated + END SUBROUTINE AA_Input_ExtrapInterp1 + + + SUBROUTINE AA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(AA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(AA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(AA_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AA_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ALLOCATED(u_out%RotGtoL) .AND. ALLOCATED(u1%RotGtoL)) THEN + DO i4 = LBOUND(u_out%RotGtoL,4),UBOUND(u_out%RotGtoL,4) + DO i3 = LBOUND(u_out%RotGtoL,3),UBOUND(u_out%RotGtoL,3) + DO i2 = LBOUND(u_out%RotGtoL,2),UBOUND(u_out%RotGtoL,2) + DO i1 = LBOUND(u_out%RotGtoL,1),UBOUND(u_out%RotGtoL,1) + b = (t(3)**2*(u1%RotGtoL(i1,i2,i3,i4) - u2%RotGtoL(i1,i2,i3,i4)) + t(2)**2*(-u1%RotGtoL(i1,i2,i3,i4) + u3%RotGtoL(i1,i2,i3,i4)))* scaleFactor + c = ( (t(2)-t(3))*u1%RotGtoL(i1,i2,i3,i4) + t(3)*u2%RotGtoL(i1,i2,i3,i4) - t(2)*u3%RotGtoL(i1,i2,i3,i4) ) * scaleFactor + u_out%RotGtoL(i1,i2,i3,i4) = u1%RotGtoL(i1,i2,i3,i4) + b + c * t_out + END DO + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%AeroCent_G) .AND. ALLOCATED(u1%AeroCent_G)) THEN + DO i3 = LBOUND(u_out%AeroCent_G,3),UBOUND(u_out%AeroCent_G,3) + DO i2 = LBOUND(u_out%AeroCent_G,2),UBOUND(u_out%AeroCent_G,2) + DO i1 = LBOUND(u_out%AeroCent_G,1),UBOUND(u_out%AeroCent_G,1) + b = (t(3)**2*(u1%AeroCent_G(i1,i2,i3) - u2%AeroCent_G(i1,i2,i3)) + t(2)**2*(-u1%AeroCent_G(i1,i2,i3) + u3%AeroCent_G(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%AeroCent_G(i1,i2,i3) + t(3)*u2%AeroCent_G(i1,i2,i3) - t(2)*u3%AeroCent_G(i1,i2,i3) ) * scaleFactor + u_out%AeroCent_G(i1,i2,i3) = u1%AeroCent_G(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%Vrel) .AND. ALLOCATED(u1%Vrel)) THEN + DO i2 = LBOUND(u_out%Vrel,2),UBOUND(u_out%Vrel,2) + DO i1 = LBOUND(u_out%Vrel,1),UBOUND(u_out%Vrel,1) + b = (t(3)**2*(u1%Vrel(i1,i2) - u2%Vrel(i1,i2)) + t(2)**2*(-u1%Vrel(i1,i2) + u3%Vrel(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vrel(i1,i2) + t(3)*u2%Vrel(i1,i2) - t(2)*u3%Vrel(i1,i2) ) * scaleFactor + u_out%Vrel(i1,i2) = u1%Vrel(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%AoANoise) .AND. ALLOCATED(u1%AoANoise)) THEN + DO i2 = LBOUND(u_out%AoANoise,2),UBOUND(u_out%AoANoise,2) + DO i1 = LBOUND(u_out%AoANoise,1),UBOUND(u_out%AoANoise,1) + b = (t(3)**2*(u1%AoANoise(i1,i2) - u2%AoANoise(i1,i2)) + t(2)**2*(-u1%AoANoise(i1,i2) + u3%AoANoise(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%AoANoise(i1,i2) + t(3)*u2%AoANoise(i1,i2) - t(2)*u3%AoANoise(i1,i2) ) * scaleFactor + u_out%AoANoise(i1,i2) = u1%AoANoise(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%Inflow) .AND. ALLOCATED(u1%Inflow)) THEN + DO i3 = LBOUND(u_out%Inflow,3),UBOUND(u_out%Inflow,3) + DO i2 = LBOUND(u_out%Inflow,2),UBOUND(u_out%Inflow,2) + DO i1 = LBOUND(u_out%Inflow,1),UBOUND(u_out%Inflow,1) + b = (t(3)**2*(u1%Inflow(i1,i2,i3) - u2%Inflow(i1,i2,i3)) + t(2)**2*(-u1%Inflow(i1,i2,i3) + u3%Inflow(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%Inflow(i1,i2,i3) + t(3)*u2%Inflow(i1,i2,i3) - t(2)*u3%Inflow(i1,i2,i3) ) * scaleFactor + u_out%Inflow(i1,i2,i3) = u1%Inflow(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated + END SUBROUTINE AA_Input_ExtrapInterp2 + + + SUBROUTINE AA_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(AA_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(AA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AA_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL AA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL AA_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL AA_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE AA_Output_ExtrapInterp + + + SUBROUTINE AA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(AA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(AA_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AA_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ALLOCATED(y_out%SumSpecNoise) .AND. ALLOCATED(y1%SumSpecNoise)) THEN + DO i3 = LBOUND(y_out%SumSpecNoise,3),UBOUND(y_out%SumSpecNoise,3) + DO i2 = LBOUND(y_out%SumSpecNoise,2),UBOUND(y_out%SumSpecNoise,2) + DO i1 = LBOUND(y_out%SumSpecNoise,1),UBOUND(y_out%SumSpecNoise,1) + b = -(y1%SumSpecNoise(i1,i2,i3) - y2%SumSpecNoise(i1,i2,i3)) + y_out%SumSpecNoise(i1,i2,i3) = y1%SumSpecNoise(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%SumSpecNoiseSep) .AND. ALLOCATED(y1%SumSpecNoiseSep)) THEN + DO i3 = LBOUND(y_out%SumSpecNoiseSep,3),UBOUND(y_out%SumSpecNoiseSep,3) + DO i2 = LBOUND(y_out%SumSpecNoiseSep,2),UBOUND(y_out%SumSpecNoiseSep,2) + DO i1 = LBOUND(y_out%SumSpecNoiseSep,1),UBOUND(y_out%SumSpecNoiseSep,1) + b = -(y1%SumSpecNoiseSep(i1,i2,i3) - y2%SumSpecNoiseSep(i1,i2,i3)) + y_out%SumSpecNoiseSep(i1,i2,i3) = y1%SumSpecNoiseSep(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%OASPL) .AND. ALLOCATED(y1%OASPL)) THEN + DO i3 = LBOUND(y_out%OASPL,3),UBOUND(y_out%OASPL,3) + DO i2 = LBOUND(y_out%OASPL,2),UBOUND(y_out%OASPL,2) + DO i1 = LBOUND(y_out%OASPL,1),UBOUND(y_out%OASPL,1) + b = -(y1%OASPL(i1,i2,i3) - y2%OASPL(i1,i2,i3)) + y_out%OASPL(i1,i2,i3) = y1%OASPL(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%OASPL_Mech) .AND. ALLOCATED(y1%OASPL_Mech)) THEN + DO i4 = LBOUND(y_out%OASPL_Mech,4),UBOUND(y_out%OASPL_Mech,4) + DO i3 = LBOUND(y_out%OASPL_Mech,3),UBOUND(y_out%OASPL_Mech,3) + DO i2 = LBOUND(y_out%OASPL_Mech,2),UBOUND(y_out%OASPL_Mech,2) + DO i1 = LBOUND(y_out%OASPL_Mech,1),UBOUND(y_out%OASPL_Mech,1) + b = -(y1%OASPL_Mech(i1,i2,i3,i4) - y2%OASPL_Mech(i1,i2,i3,i4)) + y_out%OASPL_Mech(i1,i2,i3,i4) = y1%OASPL_Mech(i1,i2,i3,i4) + b * ScaleFactor + END DO + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%DirectiviOutput) .AND. ALLOCATED(y1%DirectiviOutput)) THEN + DO i1 = LBOUND(y_out%DirectiviOutput,1),UBOUND(y_out%DirectiviOutput,1) + b = -(y1%DirectiviOutput(i1) - y2%DirectiviOutput(i1)) + y_out%DirectiviOutput(i1) = y1%DirectiviOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%OutLECoords) .AND. ALLOCATED(y1%OutLECoords)) THEN + DO i4 = LBOUND(y_out%OutLECoords,4),UBOUND(y_out%OutLECoords,4) + DO i3 = LBOUND(y_out%OutLECoords,3),UBOUND(y_out%OutLECoords,3) + DO i2 = LBOUND(y_out%OutLECoords,2),UBOUND(y_out%OutLECoords,2) + DO i1 = LBOUND(y_out%OutLECoords,1),UBOUND(y_out%OutLECoords,1) + b = -(y1%OutLECoords(i1,i2,i3,i4) - y2%OutLECoords(i1,i2,i3,i4)) + y_out%OutLECoords(i1,i2,i3,i4) = y1%OutLECoords(i1,i2,i3,i4) + b * ScaleFactor + END DO + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%PtotalFreq) .AND. ALLOCATED(y1%PtotalFreq)) THEN + DO i2 = LBOUND(y_out%PtotalFreq,2),UBOUND(y_out%PtotalFreq,2) + DO i1 = LBOUND(y_out%PtotalFreq,1),UBOUND(y_out%PtotalFreq,1) + b = -(y1%PtotalFreq(i1,i2) - y2%PtotalFreq(i1,i2)) + y_out%PtotalFreq(i1,i2) = y1%PtotalFreq(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutputForPE) .AND. ALLOCATED(y1%WriteOutputForPE)) THEN + DO i1 = LBOUND(y_out%WriteOutputForPE,1),UBOUND(y_out%WriteOutputForPE,1) + b = -(y1%WriteOutputForPE(i1) - y2%WriteOutputForPE(i1)) + y_out%WriteOutputForPE(i1) = y1%WriteOutputForPE(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutputSep) .AND. ALLOCATED(y1%WriteOutputSep)) THEN + DO i1 = LBOUND(y_out%WriteOutputSep,1),UBOUND(y_out%WriteOutputSep,1) + b = -(y1%WriteOutputSep(i1) - y2%WriteOutputSep(i1)) + y_out%WriteOutputSep(i1) = y1%WriteOutputSep(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutputNode) .AND. ALLOCATED(y1%WriteOutputNode)) THEN + DO i1 = LBOUND(y_out%WriteOutputNode,1),UBOUND(y_out%WriteOutputNode,1) + b = -(y1%WriteOutputNode(i1) - y2%WriteOutputNode(i1)) + y_out%WriteOutputNode(i1) = y1%WriteOutputNode(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE AA_Output_ExtrapInterp1 + + + SUBROUTINE AA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(AA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(AA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(AA_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AA_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ALLOCATED(y_out%SumSpecNoise) .AND. ALLOCATED(y1%SumSpecNoise)) THEN + DO i3 = LBOUND(y_out%SumSpecNoise,3),UBOUND(y_out%SumSpecNoise,3) + DO i2 = LBOUND(y_out%SumSpecNoise,2),UBOUND(y_out%SumSpecNoise,2) + DO i1 = LBOUND(y_out%SumSpecNoise,1),UBOUND(y_out%SumSpecNoise,1) + b = (t(3)**2*(y1%SumSpecNoise(i1,i2,i3) - y2%SumSpecNoise(i1,i2,i3)) + t(2)**2*(-y1%SumSpecNoise(i1,i2,i3) + y3%SumSpecNoise(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%SumSpecNoise(i1,i2,i3) + t(3)*y2%SumSpecNoise(i1,i2,i3) - t(2)*y3%SumSpecNoise(i1,i2,i3) ) * scaleFactor + y_out%SumSpecNoise(i1,i2,i3) = y1%SumSpecNoise(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%SumSpecNoiseSep) .AND. ALLOCATED(y1%SumSpecNoiseSep)) THEN + DO i3 = LBOUND(y_out%SumSpecNoiseSep,3),UBOUND(y_out%SumSpecNoiseSep,3) + DO i2 = LBOUND(y_out%SumSpecNoiseSep,2),UBOUND(y_out%SumSpecNoiseSep,2) + DO i1 = LBOUND(y_out%SumSpecNoiseSep,1),UBOUND(y_out%SumSpecNoiseSep,1) + b = (t(3)**2*(y1%SumSpecNoiseSep(i1,i2,i3) - y2%SumSpecNoiseSep(i1,i2,i3)) + t(2)**2*(-y1%SumSpecNoiseSep(i1,i2,i3) + y3%SumSpecNoiseSep(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%SumSpecNoiseSep(i1,i2,i3) + t(3)*y2%SumSpecNoiseSep(i1,i2,i3) - t(2)*y3%SumSpecNoiseSep(i1,i2,i3) ) * scaleFactor + y_out%SumSpecNoiseSep(i1,i2,i3) = y1%SumSpecNoiseSep(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%OASPL) .AND. ALLOCATED(y1%OASPL)) THEN + DO i3 = LBOUND(y_out%OASPL,3),UBOUND(y_out%OASPL,3) + DO i2 = LBOUND(y_out%OASPL,2),UBOUND(y_out%OASPL,2) + DO i1 = LBOUND(y_out%OASPL,1),UBOUND(y_out%OASPL,1) + b = (t(3)**2*(y1%OASPL(i1,i2,i3) - y2%OASPL(i1,i2,i3)) + t(2)**2*(-y1%OASPL(i1,i2,i3) + y3%OASPL(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%OASPL(i1,i2,i3) + t(3)*y2%OASPL(i1,i2,i3) - t(2)*y3%OASPL(i1,i2,i3) ) * scaleFactor + y_out%OASPL(i1,i2,i3) = y1%OASPL(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%OASPL_Mech) .AND. ALLOCATED(y1%OASPL_Mech)) THEN + DO i4 = LBOUND(y_out%OASPL_Mech,4),UBOUND(y_out%OASPL_Mech,4) + DO i3 = LBOUND(y_out%OASPL_Mech,3),UBOUND(y_out%OASPL_Mech,3) + DO i2 = LBOUND(y_out%OASPL_Mech,2),UBOUND(y_out%OASPL_Mech,2) + DO i1 = LBOUND(y_out%OASPL_Mech,1),UBOUND(y_out%OASPL_Mech,1) + b = (t(3)**2*(y1%OASPL_Mech(i1,i2,i3,i4) - y2%OASPL_Mech(i1,i2,i3,i4)) + t(2)**2*(-y1%OASPL_Mech(i1,i2,i3,i4) + y3%OASPL_Mech(i1,i2,i3,i4)))* scaleFactor + c = ( (t(2)-t(3))*y1%OASPL_Mech(i1,i2,i3,i4) + t(3)*y2%OASPL_Mech(i1,i2,i3,i4) - t(2)*y3%OASPL_Mech(i1,i2,i3,i4) ) * scaleFactor + y_out%OASPL_Mech(i1,i2,i3,i4) = y1%OASPL_Mech(i1,i2,i3,i4) + b + c * t_out + END DO + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%DirectiviOutput) .AND. ALLOCATED(y1%DirectiviOutput)) THEN + DO i1 = LBOUND(y_out%DirectiviOutput,1),UBOUND(y_out%DirectiviOutput,1) + b = (t(3)**2*(y1%DirectiviOutput(i1) - y2%DirectiviOutput(i1)) + t(2)**2*(-y1%DirectiviOutput(i1) + y3%DirectiviOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%DirectiviOutput(i1) + t(3)*y2%DirectiviOutput(i1) - t(2)*y3%DirectiviOutput(i1) ) * scaleFactor + y_out%DirectiviOutput(i1) = y1%DirectiviOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%OutLECoords) .AND. ALLOCATED(y1%OutLECoords)) THEN + DO i4 = LBOUND(y_out%OutLECoords,4),UBOUND(y_out%OutLECoords,4) + DO i3 = LBOUND(y_out%OutLECoords,3),UBOUND(y_out%OutLECoords,3) + DO i2 = LBOUND(y_out%OutLECoords,2),UBOUND(y_out%OutLECoords,2) + DO i1 = LBOUND(y_out%OutLECoords,1),UBOUND(y_out%OutLECoords,1) + b = (t(3)**2*(y1%OutLECoords(i1,i2,i3,i4) - y2%OutLECoords(i1,i2,i3,i4)) + t(2)**2*(-y1%OutLECoords(i1,i2,i3,i4) + y3%OutLECoords(i1,i2,i3,i4)))* scaleFactor + c = ( (t(2)-t(3))*y1%OutLECoords(i1,i2,i3,i4) + t(3)*y2%OutLECoords(i1,i2,i3,i4) - t(2)*y3%OutLECoords(i1,i2,i3,i4) ) * scaleFactor + y_out%OutLECoords(i1,i2,i3,i4) = y1%OutLECoords(i1,i2,i3,i4) + b + c * t_out + END DO + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%PtotalFreq) .AND. ALLOCATED(y1%PtotalFreq)) THEN + DO i2 = LBOUND(y_out%PtotalFreq,2),UBOUND(y_out%PtotalFreq,2) + DO i1 = LBOUND(y_out%PtotalFreq,1),UBOUND(y_out%PtotalFreq,1) + b = (t(3)**2*(y1%PtotalFreq(i1,i2) - y2%PtotalFreq(i1,i2)) + t(2)**2*(-y1%PtotalFreq(i1,i2) + y3%PtotalFreq(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%PtotalFreq(i1,i2) + t(3)*y2%PtotalFreq(i1,i2) - t(2)*y3%PtotalFreq(i1,i2) ) * scaleFactor + y_out%PtotalFreq(i1,i2) = y1%PtotalFreq(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutputForPE) .AND. ALLOCATED(y1%WriteOutputForPE)) THEN + DO i1 = LBOUND(y_out%WriteOutputForPE,1),UBOUND(y_out%WriteOutputForPE,1) + b = (t(3)**2*(y1%WriteOutputForPE(i1) - y2%WriteOutputForPE(i1)) + t(2)**2*(-y1%WriteOutputForPE(i1) + y3%WriteOutputForPE(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutputForPE(i1) + t(3)*y2%WriteOutputForPE(i1) - t(2)*y3%WriteOutputForPE(i1) ) * scaleFactor + y_out%WriteOutputForPE(i1) = y1%WriteOutputForPE(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutputSep) .AND. ALLOCATED(y1%WriteOutputSep)) THEN + DO i1 = LBOUND(y_out%WriteOutputSep,1),UBOUND(y_out%WriteOutputSep,1) + b = (t(3)**2*(y1%WriteOutputSep(i1) - y2%WriteOutputSep(i1)) + t(2)**2*(-y1%WriteOutputSep(i1) + y3%WriteOutputSep(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutputSep(i1) + t(3)*y2%WriteOutputSep(i1) - t(2)*y3%WriteOutputSep(i1) ) * scaleFactor + y_out%WriteOutputSep(i1) = y1%WriteOutputSep(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%WriteOutputNode) .AND. ALLOCATED(y1%WriteOutputNode)) THEN + DO i1 = LBOUND(y_out%WriteOutputNode,1),UBOUND(y_out%WriteOutputNode,1) + b = (t(3)**2*(y1%WriteOutputNode(i1) - y2%WriteOutputNode(i1)) + t(2)**2*(-y1%WriteOutputNode(i1) + y3%WriteOutputNode(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutputNode(i1) + t(3)*y2%WriteOutputNode(i1) - t(2)*y3%WriteOutputNode(i1) ) * scaleFactor + y_out%WriteOutputNode(i1) = y1%WriteOutputNode(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE AA_Output_ExtrapInterp2 + +END MODULE AeroAcoustics_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index e01d50f7af..34a4dc9478 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1,7 +1,7 @@ !********************************************************************************************************************************** ! LICENSING ! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! Copyright (C) 2016-2018 Envision Energy USA, LTD +! Copyright (C) 2016-2019 Envision Energy USA, LTD ! ! This file is part of AeroDyn. ! @@ -27,8 +27,10 @@ module AeroDyn use BEMT use AirfoilInfo use NWTC_LAPACK + use AeroAcoustics use UnsteadyAero - + use FVW + use FVW_Subs, only: FVW_AeroOuts implicit none @@ -59,7 +61,6 @@ module AeroDyn ! states(z) PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - contains !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., @@ -82,93 +83,31 @@ subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) integer(IntKi) :: i, j, k, f integer(IntKi) :: NumCoords -#ifdef DBG_OUTS - integer(IntKi) :: m - character(6) ::chanPrefix - character(3) :: TmpChar -#endif - ! Initialize variables for this routine + ! Initialize variables for this routine errStat = ErrID_None errMsg = "" InitOut%AirDens = p%AirDens - - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return -#ifdef DBG_OUTS - ! Loop over blades and nodes to populate the output channel names and units - - do k=1,p%numBlades - do j=1, p%NumBlNds - - m = (k-1)*p%NumBlNds*23 + (j-1)*23 - - WRITE (TmpChar,'(I3.3)') j - chanPrefix = "B"//trim(num2lstr(k))//"N"//TmpChar - InitOut%WriteOutputHdr( m + 1 ) = trim(chanPrefix)//"Twst" - InitOut%WriteOutputUnt( m + 1 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 2 ) = trim(chanPrefix)//"Psi" - InitOut%WriteOutputUnt( m + 2 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 3 ) = trim(chanPrefix)//"Vx" - InitOut%WriteOutputUnt( m + 3 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 4 ) = trim(chanPrefix)//"Vy" - InitOut%WriteOutputUnt( m + 4 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 5 ) = ' '//trim(chanPrefix)//"AIn" - InitOut%WriteOutputUnt( m + 5 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 6 ) = ' '//trim(chanPrefix)//"ApIn" - InitOut%WriteOutputUnt( m + 6 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 7 ) = trim(chanPrefix)//"Vrel" - InitOut%WriteOutputUnt( m + 7 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 8 ) = ' '//trim(chanPrefix)//"Phi" - InitOut%WriteOutputUnt( m + 8 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 9 ) = ' '//trim(chanPrefix)//"AOA" - InitOut%WriteOutputUnt( m + 9 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 10 ) = ' '//trim(chanPrefix)//"Cl" - InitOut%WriteOutputUnt( m + 10 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 11 ) = ' '//trim(chanPrefix)//"Cd" - InitOut%WriteOutputUnt( m + 11 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 12 ) = ' '//trim(chanPrefix)//"Cm" - InitOut%WriteOutputUnt( m + 12 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 13 ) = ' '//trim(chanPrefix)//"Cx" - InitOut%WriteOutputUnt( m + 13 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 14 ) = ' '//trim(chanPrefix)//"Cy" - InitOut%WriteOutputUnt( m + 14 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 15 ) = ' '//trim(chanPrefix)//"Cn" - InitOut%WriteOutputUnt( m + 15 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 16 ) = ' '//trim(chanPrefix)//"Ct" - InitOut%WriteOutputUnt( m + 16 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 17 ) = ' '//trim(chanPrefix)//"Fl" - InitOut%WriteOutputUnt( m + 17 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 18 ) = ' '//trim(chanPrefix)//"Fd" - InitOut%WriteOutputUnt( m + 18 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 19 ) = ' '//trim(chanPrefix)//"M" - InitOut%WriteOutputUnt( m + 19 ) = ' (N/m^2) ' - InitOut%WriteOutputHdr( m + 20 ) = ' '//trim(chanPrefix)//"Fx" - InitOut%WriteOutputUnt( m + 20 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 21 ) = ' '//trim(chanPrefix)//"Fy" - InitOut%WriteOutputUnt( m + 21 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 22 ) = ' '//trim(chanPrefix)//"Fn" - InitOut%WriteOutputUnt( m + 22 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 23 ) = ' '//trim(chanPrefix)//"Ft" - InitOut%WriteOutputUnt( m + 23 ) = ' (N/m) ' - - end do - end do -#else do i=1,p%NumOuts InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do -#endif - + + + ! Set the info in WriteOutputHdr and WriteOutputUnt + CALL AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) InitOut%Ver = AD_Ver @@ -369,18 +308,52 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! initialize BEMT after setting parameters and inputs because we are going to use the already- ! calculated node positions from the input meshes - call Init_BEMTmodule( InputFileData, u, m%BEMT_u(1), p, x%BEMT, xd%BEMT, z%BEMT, & - OtherState%BEMT, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - call BEMT_CopyInput( m%BEMT_u(1), m%BEMT_u(2), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (p%WakeMod /= WakeMod_FVW) then + call Init_BEMTmodule( InputFileData, u, m%BEMT_u(1), p, x%BEMT, xd%BEMT, z%BEMT, & + OtherState%BEMT, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + call BEMT_CopyInput( m%BEMT_u(1), m%BEMT_u(2), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + - + !............................................................................................ + ! Initialize the AeroAcoustics Module if the CompAA flag is set + !............................................................................................ + if (p%CompAA) then + call Init_AAmodule( InitInp, InputFileData, u, m%AA_u, p, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + endif + + !------------------------------------------------------------------------------------------------- + ! Initialize FVW module if it is used + !------------------------------------------------------------------------------------------------- + ! Unfortunately we do not know the interpolation order used by OpenFAST glue code at this point, + ! so we can't size things exactly. This means that we either must size too big here, or we must + ! resize in the FVW code at the first CalcOutput call. This is a bit problematic for efficiency + ! but not a complete deal-breaker. + if (p%WakeMod == WakeMod_FVW) then + if (.not. allocated(m%FVW_u)) Allocate(m%FVW_u(3)) !size(u))) + call Init_FVWmodule( InputFileData, u, m%FVW_u(1), p, x%FVW, xd%FVW, z%FVW, & + OtherState%FVW, m%FVW_y, m%FVW, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + ! populate the rest of the FVW_u so that extrap-interp will work + do i=2,3 !size(u) + call FVW_CopyInput( m%FVW_u(1), m%FVW_u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + enddo + endif + + !............................................................................................ ! Define outputs here !............................................................................................ @@ -401,6 +374,13 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call Init_MiscVars(m, p, u, y, errStat2, errMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !............................................................................................ + ! Initialize other states + !............................................................................................ + ! The wake from FVW is stored in other states. This may not be the best place to put it! + call Init_OtherStates(m, p, OtherState, errStat2, errMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !............................................................................................ ! Define initialization output here !............................................................................................ @@ -432,7 +412,14 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if - + !............................................................................................ + ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which + ! this module must be called here: + !............................................................................................ + + Interval = p%DT + + call Cleanup() contains @@ -475,9 +462,10 @@ subroutine AD_ReInit(p, x, xd, z, OtherState, m, Interval, ErrStat, ErrMsg ) ! we could get around this by figuring out what needs to change when we modify the dt parameter... probably just some unused-parameters ! and the UA filter end if - - call BEMT_ReInit(p%BEMT,x%BEMT,xd%BEMT,z%BEMT,OtherState%BEMT,m%BEMT,p%AFI) - + + if (p%WakeMod /= WakeMod_FVW) & + call BEMT_ReInit(p%BEMT,x%BEMT,xd%BEMT,z%BEMT,OtherState%BEMT,m%BEMT,p%AFI) + end subroutine AD_ReInit !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. @@ -494,7 +482,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) integer(intKi) :: k integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_OtherStates' + character(*), parameter :: RoutineName = 'Init_MiscVars' ! Initialize variables for this routine @@ -513,11 +501,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) m%SigmaCavitCrit = 0.0_ReKi m%CavitWarnSet = .false. ! arrays for output -#ifdef DBG_OUTS - allocate( m%AllOuts(0:p%NumOuts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#else allocate( m%AllOuts(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#endif if (ErrStat2 /= 0) then call SetErrStat( ErrID_Fatal, "Error allocating AllOuts.", errStat, errMsg, RoutineName ) return @@ -581,6 +565,28 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) end subroutine Init_MiscVars !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes (allocates) the misc variables for use during the simulation. +subroutine Init_OtherStates(m, p, OtherState, errStat, errMsg) + type(AD_MiscVarType), intent(in ) :: m !< misc/optimization data (not defined in submodules) + type(AD_ParameterType), intent(in ) :: p !< Parameters + type(AD_OtherStateType), intent(inout) :: OtherState !< Discrete states + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_OtherStates' + + errStat = ErrID_None + errMsg = "" + ! store Wake positions in otherstates. This may not be the best location + if (allocated(m%FVW%r_wind)) then + call AllocAry( OtherState%WakeLocationPoints, 3_IntKi, size(m%FVW%r_wind,DIM=2), ' OtherState%WakeLocationPoints', ErrStat2, ErrMsg2 ) ! must be same size as m%r_wind from FVW + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + OtherState%WakeLocationPoints = m%FVW%r_wind + endif +end subroutine Init_OtherStates +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes AeroDyn meshes and output array variables for use during the simulation. subroutine Init_y(y, u, p, errStat, errMsg) type(AD_OutputType), intent( out) :: y !< Module outputs @@ -644,8 +650,8 @@ subroutine Init_y(y, u, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do - - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) + + call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) RETURN @@ -928,7 +934,8 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) else p%FrozenWake = .FALSE. end if - + + p%CompAA = InputFileData%CompAA ! p%numBlades = InitInp%numBlades ! this was set earlier because it was necessary p%NumBlNds = InputFileData%BladeProps(1)%NumBlNds @@ -953,12 +960,6 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier to it could be used -#ifdef DBG_OUTS - p%NBlOuts = 23 - p%numOuts = p%NumBlNds*p%NumBlades*p%NBlOuts - p%NTwOuts = 0 - -#else p%numOuts = InputFileData%NumOuts p%NBlOuts = InputFileData%NBlOuts p%BlOutNd = InputFileData%BlOutNd @@ -974,7 +975,15 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return -#endif + + + + ! Set the nodal output parameters. Note there is some validation in this, so we might get an error from here. + CALL AllBldNdOuts_SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + end subroutine SetParameters !---------------------------------------------------------------------------------------------------------------------------------- @@ -1001,8 +1010,10 @@ subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ErrMsg = "" - ! Place any last minute operations or calculations here: - + ! End the FVW submodule + if (p%WakeMod == WakeMod_FVW ) then + call FVW_End( m%FVW_u, p%FVW, x%FVW, xd%FVW, z%FVW, OtherState%FVW, m%FVW_y, m%FVW, ErrStat, ErrMsg ) + endif ! Close files here: @@ -1075,6 +1086,7 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat end if ! set values of m%BEMT_u(2) from inputs interpolated at t+dt: + ! NOTE: framework has t+dt at u(1) call AD_Input_ExtrapInterp(u,utimes,uInterp,t+p%DT, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1082,6 +1094,7 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! set values of m%BEMT_u(1) from inputs (uInterp) interpolated at t: + ! NOTE: framework has t at u(2) ! I'm doing this second in case we want the other misc vars at t as before, but I don't think it matters call AD_Input_ExtrapInterp(u,utimes,uInterp, t, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1089,11 +1102,38 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat call SetInputs(p, uInterp, m, 1, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Call into the BEMT update states NOTE: This is a non-standard framework interface!!!!! GJH - call BEMT_UpdateStates(t, n, m%BEMT_u(1), m%BEMT_u(2), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI, m%BEMT, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - + + if (p%WakeMod /= WakeMod_FVW) then + ! Call into the BEMT update states NOTE: This is a non-standard framework interface!!!!! GJH + ! Also note BEMT_u(1) and BEMT_u(2) are not following the framework convention for t+dt, t + call BEMT_UpdateStates(t, n, m%BEMT_u(1), m%BEMT_u(2), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI, m%BEMT, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Call AeroAcoustics updates states + if ( p%CompAA ) then + ! We need the outputs from BEMT as inputs to AeroAcoustics module + ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA + call SetInputsForAA(p, u(1), m, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_UpdateStates(t, n,m%AA, m%AA_u, p%AA, xd%AA, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + else ! Call the FVW sub module + ! This needs to extract the inputs from the AD data types (mesh) and copy pieces for the FVW module + call SetInputsForFVW(p, u, m, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Note: the setup is handled above in the SetInputs routine + call FVW_UpdateStates( t, n, m%FVW_u, utimes, p%FVW, x%FVW, xd%FVW, z%FVW, OtherState%FVW, p%AFI, m%FVW, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! The wind points are passed out as other states. These really correspond to the propogation of the vortex to the next wind position. + if (allocated(OtherState%WakeLocationPoints)) then + OtherState%WakeLocationPoints = m%FVW%r_wind + endif + ! UA TODO + !call UA_UpdateState_Wrapper(p%AFI, n, p%FVW, x%FVW, xd%FVW, OtherState%FVW, m%FVW, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif call Cleanup() @@ -1107,7 +1147,7 @@ end subroutine AD_UpdateStates !! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. !! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for !! for a complete description of each output parameter. -subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, 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. @@ -1125,8 +1165,10 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call + ! NOTE: there are inconsistencies in the usage of m%BEMT_u(i) from the way the framework is setup integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: i integer(intKi) :: j @@ -1135,22 +1177,57 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CalcOutput' real(ReKi) :: SigmaCavitCrit, SigmaCavit - + LOGICAL :: CalcWriteOutput + ErrStat = ErrID_None ErrMsg = "" +#ifdef UA_OUTS + ! if ( mod(REAL(t,ReKi),.1) < p%dt) then + if (allocated(m%FVW%y_UA%WriteOutput)) m%FVW%y_UA%WriteOutput = 0.0 !reset to zero in case UA shuts off mid-simulation + ! endif +#endif + + 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, u, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Call the BEMT module CalcOutput. Notice that the BEMT outputs are purposely attached to AeroDyn's MiscVar structure to - ! avoid issues with the coupling code - - call BEMT_CalcOutput(t, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call SetOutputsFromBEMT(p, m, y ) - + if (p%WakeMod /= WakeMod_FVW) then + ! Call the BEMT module CalcOutput. Notice that the BEMT outputs are purposely attached to AeroDyn's MiscVar structure to + ! avoid issues with the coupling code + + call BEMT_CalcOutput(t, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call SetOutputsFromBEMT(p, m, y ) + + if ( p%CompAA ) then + ! We need the outputs from BEMT as inputs to AeroAcoustics module + ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA + call SetInputsForAA(p, u, m, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_CalcOutput(t, m%AA_u, p%AA, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + else !(p%WakeMod == WakeMod_FVW) + ! This needs to extract the inputs from the AD data types (mesh) and copy pieces for the FVW module + 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call SetOutputsFromFVW( u, p, OtherState, xd, m, y, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + if ( p%TwrAero ) then call ADTwr_CalcOutput(p, u, m, y, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1182,29 +1259,35 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- - if (p%NumOuts > 0) then -#ifdef DBG_OUTS - call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) -#else - call Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) -#endif - 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 -#ifdef DBG_OUTS - y%WriteOutput(i) = m%AllOuts( i ) -#else - y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) -#endif - - end do ! i - All selected output channels - + if (CalcWriteOutput) then + if (p%NumOuts > 0) then + call Calc_WriteOutput( p, u, m, y, OtherState, xd, indx, 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 + + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteAllBldNdOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if + +#ifdef UA_OUTS + ! if ( mod(REAL(t,ReKi),.1) < p%dt) then + if (allocated(m%FVW%y_UA%WriteOutput)) & + WRITE (69, '(F20.6,'//trim(num2lstr(size(m%FVW%y_UA%WriteOutput)))//'(:,1x,ES19.5E3))') t, ( m%FVW%y_UA%WriteOutput(i), i=1,size(m%FVW%y_UA%WriteOutput)) + ! end if +#endif end subroutine AD_CalcOutput @@ -1245,7 +1328,7 @@ subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_re end if - call SetInputs(p, u, m, indx, errStat2, errMsg2) + call SetInputs(p, u, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1282,12 +1365,14 @@ subroutine SetInputs(p, u, m, indx, errStat, errMsg) else m%DisturbedInflow = u%InflowOnBlade end if - - ! This needs to extract the inputs from the AD data types (mesh) and massage them for the BEMT module - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - + + if (p%WakeMod /= WakeMod_FVW) then + ! This needs to extract the inputs from the AD data types (mesh) and massage them for the BEMT module + call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + + end subroutine SetInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets m%BEMT_u(indx). @@ -1303,15 +1388,13 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) ! local variables real(ReKi) :: x_hat(3) real(ReKi) :: y_hat(3) - real(ReKi) :: z_hat(3) real(ReKi) :: x_hat_disk(3) real(ReKi) :: y_hat_disk(3) real(ReKi) :: z_hat_disk(3) real(ReKi) :: tmp(3) - real(R8Ki) :: theta(3) - real(R8Ki) :: orientation(3,3) - real(R8Ki) :: orientation_nopitch(3,3) real(ReKi) :: tmp_sz, tmp_sz_y + real(R8Ki) :: thetaBladeNds(p%NumBlNds,p%NumBlades) + real(R8Ki) :: Azimuth(p%NumBlades) integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades @@ -1320,37 +1403,16 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) character(*), parameter :: RoutineName = 'SetInputsForBEMT' - ErrStat = ErrID_None - ErrMsg = "" - - - ! calculate disk-averaged relative wind speed, V_DiskAvg - m%V_diskAvg = 0.0_ReKi - do k=1,p%NumBlades - do j=1,p%NumBlNds - tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) - m%V_diskAvg = m%V_diskAvg + tmp - end do - end do - m%V_diskAvg = m%V_diskAvg / real( p%NumBlades * p%NumBlNds, ReKi ) - - ! orientation vectors: - 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 ) + ! 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) + if (ErrStat >= AbortErrLev) return + + ! Velocity in disk normal m%BEMT_u(indx)%Un_disk = m%V_dot_x - 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 ! "Angular velocity of rotor" rad/s - m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) + 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 tmp_sz = TwoNorm( m%V_diskAvg ) @@ -1366,54 +1428,15 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) 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 - m%BEMT_u(indx)%psi(k) = 0.0_ReKi - else - m%BEMT_u(indx)%psi(k) = atan2( tmp_sz_y, tmp_sz ) - end if - end do - + m%bemt_u(indx)%psi = Azimuth + ! 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 do k=1,p%NumBlades - - ! construct system equivalent to u%BladeRootMotion(k)%Orientation, but without the blade-pitch angle: - - !orientation = matmul( u%BladeRootMotion(k)%Orientation(:,:,1), transpose(u%HubMotion%Orientation(:,:,1)) ) - 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) -#ifndef DBG_OUTS - 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 - - orientation = EulerConstruct( theta ) - orientation_nopitch = matmul( orientation, u%HubMotion%Orientation(:,:,1) ) ! withoutPitch_theta_Root(k) - do j=1,p%NumBlNds - ! form coordinate system equivalent to u%BladeMotion(k)%Orientation(:,:,j) but without live sweep (due to in-plane - ! deflection), blade-pitch and twist (aerodynamic + elastic) angles: - - ! orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose(orientation_nopitch) ) - call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeMotion(k)%Orientation(:,:,j), orientation_nopitch, 0.0_R8Ki, orientation, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - theta = EulerExtract( orientation ) !root(k)WithoutPitch_theta(j)_blade(k) - - m%BEMT_u(indx)%theta(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) + m%BEMT_u(indx)%theta(j,k) = thetaBladeNds(j,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade x_hat = m%WithoutSweepPitchTwist(1,:,j,k) y_hat = m%WithoutSweepPitchTwist(2,:,j,k) @@ -1446,6 +1469,210 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) m%BEMT_u(indx)%UserProp = u%UserProp end subroutine SetInputsForBEMT + +subroutine DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) + type(AD_ParameterType), intent(in ) :: p !< AD parameters + type(AD_InputType), intent(in ) :: u !< AD Inputs at Time + type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables + real(ReKi), intent( out) :: x_hat_disk(3) + real(ReKi), intent( out) :: y_hat_disk(3) + real(ReKi), intent( out) :: z_hat_disk(3) + real(R8Ki), intent( out) :: Azimuth(p%NumBlades) + real(ReKi) :: z_hat(3) + real(ReKi) :: tmp(3) + real(ReKi) :: tmp_sz, tmp_sz_y + integer(intKi) :: j ! loop counter for nodes + integer(intKi) :: k ! loop counter for blades + + ! calculate disk-averaged relative wind speed, V_DiskAvg + m%V_diskAvg = 0.0_ReKi + do k=1,p%NumBlades + do j=1,p%NumBlNds + tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) + m%V_diskAvg = m%V_diskAvg + tmp + end do + end do + m%V_diskAvg = m%V_diskAvg / real( p%NumBlades * p%NumBlNds, ReKi ) + + ! orientation vectors: + 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 + else + Azimuth(k) = atan2( tmp_sz_y, tmp_sz ) + end if + end do +end subroutine DiskAvgValues +subroutine GeomWithoutSweepPitchTwist(p,u,m,thetaBladeNds,ErrStat,ErrMsg) + type(AD_ParameterType), intent(in ) :: p !< AD parameters + type(AD_InputType), intent(in ) :: u !< AD Inputs at Time + type(AD_MiscVarType), 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 + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki) :: theta(3) + real(R8Ki) :: orientation(3,3) + real(R8Ki) :: orientation_nopitch(3,3) + + integer(intKi) :: j ! loop counter for nodes + integer(intKi) :: k ! loop counter for blades + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'GeomWithoutSweepPitchTwist' + + ErrStat = ErrID_None + ErrMsg = "" + + ! 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 + do k=1,p%NumBlades + + ! construct system equivalent to u%BladeRootMotion(k)%Orientation, but without the blade-pitch angle: + + 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) + m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output + theta(3) = 0.0_ReKi + m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + + orientation = EulerConstruct( theta ) + orientation_nopitch = matmul( orientation, u%HubMotion%Orientation(:,:,1) ) ! withoutPitch_theta_Root(k) + + do j=1,p%NumBlNds + + ! form coordinate system equivalent to u%BladeMotion(k)%Orientation(:,:,j) but without live sweep (due to in-plane + ! deflection), blade-pitch and twist (aerodynamic + elastic) angles: + + ! orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose(orientation_nopitch) ) + call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeMotion(k)%Orientation(:,:,j), orientation_nopitch, 0.0_R8Ki, orientation, errStat2, errMsg2) + 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 + + + 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 +end subroutine GeomWithoutSweepPitchTwist +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets m%FVW_u(indx). +subroutine SetInputsForFVW(p, u, m, errStat, errMsg) + + type(AD_ParameterType), intent(in ) :: p !< AD parameters + type(AD_InputType), intent(in ) :: u(:) !< AD Inputs at Time + type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + real(ReKi) :: x_hat_disk(3) + real(ReKi) :: y_hat_disk(3) + real(ReKi) :: z_hat_disk(3) + real(R8Ki) :: thetaBladeNds(p%NumBlNds,p%NumBlades) + real(R8Ki) :: Azimuth(p%NumBlades) + + integer(intKi) :: tIndx + integer(intKi) :: k ! loop counter for blades + character(*), parameter :: RoutineName = 'SetInputsForFVW' + + do tIndx=1,size(u) + ! 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, u(tIndx), m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) + call GeomWithoutSweepPitchTwist(p,u(tIndx),m,thetaBladeNds,ErrStat,ErrMsg) + if (ErrStat >= AbortErrLev) return + + ! Rather than use a meshcopy, we will just copy what we need to the WingsMesh + ! NOTE: MeshCopy requires the source mesh to be INOUT intent + ! NOTE2: If we change the WingsMesh to not be identical to the BladeMotion mesh, add the mapping stuff here. + do k=1,p%NumBlades + if ( u(tIndx)%BladeMotion(k)%nNodes /= m%FVW_u(tIndx)%WingsMesh(k)%nNodes ) then + ErrStat = ErrID_Fatal + ErrMsg = RoutineName//": WingsMesh contains different number of nodes than the BladeMotion mesh" + return + endif + m%FVW%PitchAndTwist(:,k) = thetaBladeNds(:,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade + m%FVW_u(tIndx)%WingsMesh(k)%TranslationDisp = u(tIndx)%BladeMotion(k)%TranslationDisp + m%FVW_u(tIndx)%WingsMesh(k)%Orientation = u(tIndx)%BladeMotion(k)%Orientation + m%FVW_u(tIndx)%WingsMesh(k)%TranslationVel = u(tIndx)%BladeMotion(k)%TranslationVel + m%FVW_u(tIndx)%HubPosition = u(tIndx)%HubMotion%Position(:,1) + u(tIndx)%HubMotion%TranslationDisp(:,1) + m%FVW_u(tIndx)%HubOrientation = u(tIndx)%HubMotion%Orientation(:,:,1) + enddo + if (ALLOCATED(m%FVW_u(tIndx)%V_wind)) then + m%FVW_u(tIndx)%V_wind = u(tIndx)%InflowWakeVel + ! Applying tower shadow to V_wind based on r_wind positions + ! NOTE: m%DisturbedInflow also contains tower shadow and we need it for CalcOutput + if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then + if (p%FVW%TwrShadowOnWake) then + call TwrInflArray( p, u(tIndx), m, m%FVW%r_wind, m%FVW_u(tIndx)%V_wind, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + endif + end if + endif + enddo + m%FVW%Vwnd_ND = m%DisturbedInflow ! Nasty transfer for UA, but this is temporary, waiting for AeroDyn to handle UA +end subroutine SetInputsForFVW +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets m%AA_u. +subroutine SetInputsForAA(p, u, m, errStat, errMsg) + type(AD_ParameterType), intent(in ) :: p !< AD parameters + type(AD_InputType), intent(in ) :: u !< AD Inputs at Time + 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 + ! local variables + integer(intKi) :: i ! loop counter for nodes + integer(intKi) :: j ! loop counter for blades + + ErrStat = ErrID_None + ErrMsg = "" + + do j=1,p%NumBlades + do i = 1,p%NumBlNds + ! Get local orientation matrix to transform from blade element coordinates to global coordinates + m%AA_u%RotGtoL(:,:,i,j) = u%BladeMotion(j)%Orientation(:,:,i) + + ! Get blade element aerodynamic center in global coordinates + m%AA_u%AeroCent_G(:,i,j) = u%BladeMotion(j)%Position(:,i) + u%BladeMotion(j)%TranslationDisp(:,i) + + ! Set the blade element relative velocity (including induction) + m%AA_u%Vrel(i,j) = m%BEMT_y%Vrel(i,j) + + ! Set the blade element angle of attack + m%AA_u%AoANoise(i,j) = m%BEMT_y%AOA(i,j) + + ! Set the blade element undisturbed flow + m%AA_u%Inflow(1,i,j) = u%InflowonBlade(1,i,j) + m%AA_u%Inflow(2,i,j) = u%InflowonBlade(2,i,j) + m%AA_u%Inflow(3,i,j) = u%InflowonBlade(3,i,j) + 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 ) @@ -1489,6 +1716,126 @@ subroutine SetOutputsFromBEMT(p, m, y ) end subroutine SetOutputsFromBEMT + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine converts outputs from FVW (stored in m%FVW_y) into values on the AeroDyn BladeLoad output mesh. +subroutine SetOutputsFromFVW(u, p, OtherState, xd, m, y, ErrStat, ErrMsg) + use BEMTUnCoupled, only: Compute_UA_AirfoilCoefs + TYPE(AD_InputType), intent(in ) :: u !< Inputs at Time t + type(AD_ParameterType), intent(in ) :: p !< AD parameters + type(AD_OtherStateType), intent(in ) :: OtherState !< OtherState + type(AD_DiscreteStateType),intent(in ) :: xd !< Discrete states + type(AD_OutputType), intent(inout) :: y !< AD outputs + 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(intKi) :: j ! loop counter for nodes + integer(intKi) :: k ! loop counter for blades + real(reki) :: force(3) + real(reki) :: moment(3) + real(reki) :: q + REAL(ReKi) :: cp, sp ! cosine, sine of phi + + ! Local vars for readability + real(ReKi) :: Vind(3) + real(ReKi) :: Vstr(3) + real(ReKi) :: Vwnd(3) + real(ReKi) :: theta + ! Local variables that we store in misc for nodal outputs + real(ReKi) :: AxInd, TanInd, Vrel, phi, alpha, Re + + 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_dyn, Cd_dyn, Cm_dyn + + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat2 = 0 + ErrMsg2 = "" + + ! zero forces + force(3) = 0.0_ReKi + moment(1:2) = 0.0_ReKi + + ! set all blade outputs for all nodes (needed in nodal outputs) + ! This loop is separated from below in case we want to move it later. + do k=1,p%numBlades + do j=1,p%NumBlNds + ! --- Computing main aero variables from induction - setting local variables + Vind = m%FVW_y%Vind(1:3,j,k) + Vstr = u%BladeMotion(k)%TranslationVel(1:3,j) + Vwnd = m%DisturbedInflow(1:3,j,k) ! NOTE: contains tower shadow + theta = m%FVW%PitchAndTwist(j,k) + call FVW_AeroOuts( m%WithoutSweepPitchTwist(1:3,1:3,j,k), u%BladeMotion(k)%Orientation(1:3,1:3,j), & ! inputs + theta, Vstr(1:3), Vind(1:3), VWnd(1:3), p%KinVisc, p%FVW%Chord(j,k), & ! inputs + AxInd, TanInd, Vrel, phi, alpha, Re, UrelWind_s(1:3), ErrStat2, ErrMsg2 ) ! outputs + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') + + ! Compute steady Airfoil Coefs no matter what.. + call AFI_ComputeAirfoilCoefs( alpha, Re, 0.0_ReKi, p%AFI(p%FVW%AFindx(j,k)), AFI_interp, ErrStat, ErrMsg ) + Cl_Static = AFI_interp%Cl + Cd_Static = AFI_interp%Cd + Cm_Static = AFI_interp%Cm + + if (m%FVW%UA_Flag) then + if ((OtherState%FVW%UA_Flag(j,k)) .and. ( .not. EqualRealNos(Vrel,0.0_ReKi) ) ) then + m%FVW%m_UA%iBladeNode = j + m%FVW%m_UA%iBlade = k + call Compute_UA_AirfoilCoefs( alpha, Vrel, Re, 0.0_ReKi, p%AFI(p%FVW%AFindx(j,k)), m%FVW%p_UA, xd%FVW%UA, OtherState%FVW%UA, m%FVW%y_UA, m%FVW%m_UA, Cl_dyn, Cd_dyn, Cm_dyn, ErrStat, ErrMsg) + if(ErrStat/=ErrID_None) print*,'UA CalcOutput:', trim(ErrMsg) + end if + end if + ! Set dynamic to the (will be same as static if UA_Flag is false) + Cl_dyn = AFI_interp%Cl + Cd_dyn = AFI_interp%Cd + Cm_dyn = AFI_interp%Cm + + cp = cos(phi) + sp = sin(phi) + Cx = Cl_dyn*cp + Cd_dyn*sp + Cy = Cl_dyn*sp - Cd_dyn*cp + + q = 0.5 * p%airDens * Vrel**2 ! dynamic pressure of the jth node in the kth blade + force(1) = Cx * q * p%FVW%Chord(j,k) ! X = normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade + force(2) = -Cy * q * p%FVW%Chord(j,k) ! Y = tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade + moment(3)= Cm_dyn * q * p%FVW%Chord(j,k)**2 ! M = pitching moment per unit length of the jth node in the kth blade + + ! save these values for possible output later: + m%X(j,k) = force(1) + m%Y(j,k) = force(2) + m%M(j,k) = moment(3) + + ! note: because force and moment are 1-d arrays, I'm calculating the transpose of the force and moment outputs + ! so that I don't have to take the transpose of WithoutSweepPitchTwist(:,:,j,k) + y%BladeLoad(k)%Force(:,j) = matmul( force, m%WithoutSweepPitchTwist(:,:,j,k) ) ! force per unit length of the jth node in the kth blade + y%BladeLoad(k)%Moment(:,j) = matmul( moment, m%WithoutSweepPitchTwist(:,:,j,k) ) ! moment per unit length of the jth node in the kth blade + + ! Save results for outputs so we don't have to recalculate them all when we write outputs + m%FVW%BN_AxInd(j,k) = AxInd + m%FVW%BN_TanInd(j,k) = TanInd + m%FVW%BN_Vrel(j,k) = Vrel + m%FVW%BN_alpha(j,k) = alpha + m%FVW%BN_phi(j,k) = phi + m%FVW%BN_Re(j,k) = Re + m%FVW%BN_UrelWind_s(1:3,j,k) = UrelWind_s(1:3) + m%FVW%BN_Cl_Static(j,k) = Cl_Static + m%FVW%BN_Cd_Static(j,k) = Cd_Static + m%FVW%BN_Cm_Static(j,k) = Cm_Static + m%FVW%BN_Cl(j,k) = Cl_dyn + m%FVW%BN_Cd(j,k) = Cd_dyn + m%FVW%BN_Cm(j,k) = Cm_dyn + m%FVW%BN_Cx(j,k) = Cx + m%FVW%BN_Cy(j,k) = Cy + end do !j=nodes + end do !k=blades + + +end subroutine SetOutputsFromFVW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the AeroDyn input files. SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) @@ -1514,9 +1861,9 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) if (InputFileData%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) then - call SetErrStat ( ErrID_Fatal, 'WakeMod must '//trim(num2lstr(WakeMod_None))//' (none), '//trim(num2lstr(WakeMod_BEMT))//' (BEMT),'// & - 'or '//trim(num2lstr(WakeMod_DBEMT))//' (DBEMT).', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%WakeMod /= WakeMod_None .and. InputFileData%WakeMod /= WakeMod_BEMT .and. InputFileData%WakeMod /= WakeMod_DBEMT .and. InputFileData%WakeMod /= WakeMod_FVW) then + call SetErrStat ( ErrID_Fatal, 'WakeMod must be value of '//trim(num2lstr(WakeMod_None))//' (none), '//trim(num2lstr(WakeMod_BEMT))//' (BEMT), '// & + trim(num2lstr(WakeMod_DBEMT))//' (DBEMT), or '//trim(num2lstr(WakeMod_FVW))//' (FVW).',ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%AFAeroMod /= AFAeroMod_Steady .and. InputFileData%AFAeroMod /= AFAeroMod_BL_unsteady) then @@ -1538,7 +1885,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! BEMT/DBEMT inputs ! bjj: these checks should probably go into BEMT where they are used... - if (InputFileData%WakeMod /= WakeMod_none) then + if (InputFileData%WakeMod /= WakeMod_none .and. InputFileData%WakeMod /= WakeMod_FVW) then if ( InputFileData%MaxIter < 1 ) call SetErrStat( ErrID_Fatal, 'MaxIter must be greater than 0.', ErrStat, ErrMsg, RoutineName ) if ( InputFileData%IndToler < 0.0 .or. EqualRealNos(InputFileData%IndToler, 0.0_ReKi) ) & @@ -1669,8 +2016,8 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) call SetErrStat( ErrID_Fatal, 'Steady blade airfoil aerodynamics must be used for linearization. Set AFAeroMod=1.', ErrStat, ErrMsg, RoutineName ) end if - if (InputFileData%WakeMod == WakeMod_DBEMT) then - call SetErrStat( ErrID_Fatal, 'DBEMT cannot currently be used for linearization. Set WakeMod=0 or WakeMod=1.', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%WakeMod == WakeMod_DBEMT .or. InputFileData%WakeMod == WakeMod_FVW) then + call SetErrStat( ErrID_Fatal, 'DBEMT and FVW cannot currently be used for linearization. Set WakeMod=0 or WakeMod=1.', ErrStat, ErrMsg, RoutineName ) end if end if @@ -1771,6 +2118,102 @@ SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, NumBl, ErrStat, ErrMsg ) END SUBROUTINE Init_AFIparams !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the Airfoil Noise module from within AeroDyn. +SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, u_AD, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + type(AD_InitInputType), intent(in ) :: DrvInitInp !< AeroDyn-level initialization inputs + type(AD_InputFile), intent(in ) :: AD_InputFileData !< All the data in the AeroDyn input file + type(AD_InputType), intent(in ) :: u_AD !< AD inputs - used for input mesh node positions + type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(AD_ParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the AA parameters here + type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states + type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + type(AA_MiscVarType), intent( out) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + real(DbKi) :: Interval ! Coupling interval in seconds: the rate that + ! (1) BEMT_UpdateStates() is called in loose coupling & + ! (2) BEMT_UpdateDiscState() is called in tight coupling. + ! Input is the suggested time from the glue code; + ! Output is the actual coupling interval that will be used + ! by the glue code. + type(AA_InitInputType) :: InitInp ! Input data for initialization routine + type(AA_InitOutputType) :: InitOut ! Output for initialization routine + integer(intKi) :: i ! airfoil file index + integer(intKi) :: j ! node index + integer(intKi) :: k ! blade index + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Init_AAmodule' + ErrStat = ErrID_None + ErrMsg = "" + + ! Transfer from parameters and input file to init input + Interval = p%DT + InitInp%NumBlades = p%NumBlades + InitInp%NumBlNds = p%NumBlNds + InitInp%airDens = AD_InputFileData%AirDens + InitInp%kinVisc = AD_InputFileData%KinVisc + InitInp%InputFile = AD_InputFileData%AA_InputFile + InitInp%RootName = DrvInitInp%RootName + InitInp%SpdSound = AD_InputFileData%SpdSound + InitInp%HubHeight = DrvInitInp%HubPosition(3) + + ! --- Transfer of airfoil info + ALLOCATE ( InitInp%AFInfo( size(p%AFI) ), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName ) + RETURN + ENDIF + do i=1,size(p%AFI) + call AFI_CopyParam( p%AFI(i), InitInp%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do + + ! --- Allocate and set AirfoilID, chord and Span for each blades + ! note here that each blade is required to have the same number of nodes + call AllocAry( InitInp%BlAFID, p%NumBlNds, p%NumBlades,'InitInp%BlAFID', errStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( InitInp%BlChord, p%NumBlNds, p%NumBlades, 'BlChord', errStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( InitInp%BlSpn, p%NumBlNds, p%NumBlades, 'BlSpn', errStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + do k = 1, p%NumBlades + do j=1, AD_InputFileData%BladeProps(k)%NumBlNds + InitInp%BlChord(j,k) = AD_InputFileData%BladeProps(k)%BlChord( j) + InitInp%BlSpn (j,k) = AD_InputFileData%BladeProps(k)%BlSpn(j) + InitInp%BlAFID(j,k) = AD_InputFileData%BladeProps(k)%BlAFID(j) + end do + end do + + ! --- AeroAcoustics initialization call + call AA_Init(InitInp, u, p%AA, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (.not. equalRealNos(Interval, p%DT) ) then + call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_AAmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) + endif + + call Cleanup() + +contains + + subroutine Cleanup() + call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) + call AA_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) + end subroutine Cleanup + +END SUBROUTINE Init_AAmodule +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the BEMT module from within AeroDyn. SUBROUTINE Init_BEMTmodule( InputFileData, u_AD, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -1854,6 +2297,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, u_AD, u, p, x, xd, z, OtherState, y, if (EqualRealNos(InitInp%zHub(k),0.0_ReKi) ) & call SetErrStat( ErrID_Fatal, "zHub for blade "//trim(num2lstr(k))//" is zero.", ErrStat, ErrMsg, RoutineName) + ! zLocal is the istance along blade curve -- NOTE: this is an approximation. InitInp%zLocal(1,k) = InitInp%zHub(k) + TwoNorm( u_AD%BladeMotion(k)%Position(:,1) - u_AD%BladeRootMotion(k)%Position(:,1) ) do j=2,p%NumBlNds InitInp%zLocal(j,k) = InitInp%zLocal(j-1,k) + TwoNorm( u_AD%BladeMotion(k)%Position(:,j) - u_AD%BladeMotion(k)%Position(:,j-1) ) @@ -1904,20 +2348,181 @@ SUBROUTINE Init_BEMTmodule( InputFileData, u_AD, u, p, x, xd, z, OtherState, y, call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) if (.not. equalRealNos(Interval, p%DT) ) & - call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_BEMTmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) - - !m%UseFrozenWake = .FALSE. !BJJ: set this in BEMT - - call Cleanup() - return - -contains + call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_BEMTmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) + + !m%UseFrozenWake = .FALSE. !BJJ: set this in BEMT + + call Cleanup() + return + +contains + subroutine Cleanup() + call BEMT_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ) + call BEMT_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) + end subroutine Cleanup +END SUBROUTINE Init_BEMTmodule + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the FVW module from within AeroDyn. +SUBROUTINE Init_FVWmodule( InputFileData, u_AD, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + type(AD_InputFile), intent(in ) :: InputFileData !< All the data in the AeroDyn input file + type(AD_InputType), intent(inout) :: u_AD !< AD inputs - used for input mesh node positions (intent out for meshcopy) + type(FVW_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(AD_ParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the FVW parameters here + type(FVW_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(FVW_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(FVW_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(FVW_OtherStateType), intent( out) :: OtherState !< Initial other states + type(FVW_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + type(FVW_MiscVarType), intent( out) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + real(DbKi) :: Interval ! Coupling interval in seconds: the rate that + ! (1) FVW_UpdateStates() is called in loose coupling & + ! (2) FVW_UpdateDiscState() is called in tight coupling. + ! Input is the suggested time from the glue code; + ! Output is the actual coupling interval that will be used + ! by the glue code. + type(FVW_InitInputType) :: InitInp ! Input data for initialization routine + type(FVW_InitOutputType) :: InitOut ! Output for initialization routine + + integer(intKi) :: j ! node index + integer(intKi) :: IB ! blade index + real(ReKi) :: tmp(3), tmp_sz_y, tmp_sz + real(ReKi) :: y_hat_disk(3) + real(ReKi) :: z_hat_disk(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Init_FVWmodule' + + ! note here that each blade is required to have the same number of nodes + + ErrStat = ErrID_None + ErrMsg = "" + + ! set initialization data here: + InitInp%FVWFileName = InputFileData%FVWFileName + InitInp%numBlades = p%numBlades + InitInp%numBladeNodes = p%numBlNds + InitInp%DTaero = p%DT ! NOTE: FVW can run a lower timestep internally + InitInp%KinVisc = p%KinVisc + InitInp%RootName = p%RootName(1:len_trim(p%RootName)-2) ! Removing "AD" + + ! NOTE: The following are not meshes + ! It's just the spanwise location. + ! Also, it is off compared to the initial position of the blade + ! Also, it's centered on the hub, but that's fine for now + call AllocAry(InitInp%Chord, InitInp%numBladeNodes,InitInp%numBlades,'chord', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(InitInp%AFindx,InitInp%numBladeNodes,InitInp%numBlades,'AFindx',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(InitInp%zHub, InitInp%numBlades,'zHub', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + 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) + + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + + + ! Hub + do IB=1,p%numBlades + InitInp%zHub(IB) = TwoNorm( u_AD%BladeRootMotion(IB)%Position(:,1) - u_AD%HubMotion%Position(:,1) ) + if (EqualRealNos(InitInp%zHub(IB),0.0_ReKi) ) & + call SetErrStat( ErrID_Fatal, "zHub for blade "//trim(num2lstr(IB))//" is zero.", ErrStat, ErrMsg, RoutineName) + enddo + if (ErrStat >= AbortErrLev) then + call CleanUp() + RETURN + endif + + ! Distance along blade curve -- NOTE: this is an approximation. + do IB=1,p%numBlades + InitInp%zLocal(1,IB) = InitInp%zHub(IB) + TwoNorm( u_AD%BladeMotion(IB)%Position(:,1) - u_AD%BladeRootMotion(IB)%Position(:,1) ) + do j=2,p%NumBlNds + InitInp%zLocal(j,IB) = InitInp%zLocal(j-1,IB) + TwoNorm( u_AD%BladeMotion(IB)%Position(:,j) - u_AD%BladeMotion(IB)%Position(:,j-1) ) + end do !j=nodes + end do !IB=blades + + ! Blade tip curve distance + do IB=1,p%numBlades + InitInp%zTip(IB) = InitInp%zLocal(p%NumBlNds,IB) + end do !IB=blades + + ! Distance from blade to hub axis (includes hub radius) + y_hat_disk = u_AD%HubMotion%Orientation(2,:,1) + z_hat_disk = u_AD%HubMotion%Orientation(3,:,1) + do IB=1,p%numBlades + do j=1,p%NumBlNds + ! displaced position of the jth node in the kth blade relative to the hub: + tmp = u_AD%BladeMotion(IB)%Position(:,j) - 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%rLocal(j,IB) = sqrt( tmp_sz + tmp_sz_y ) + end do !j=nodes + end do !IB=blades + + + ! Copy over chord information + do IB=1,p%numBlades + do j=1,p%NumBlNds + InitInp%Chord (j,IB) = InputFileData%BladeProps(IB)%BlChord(j) + InitInp%AFindx(j,IB) = InputFileData%BladeProps(IB)%BlAFID(j) + end do + end do + + ! Unsteady Aero Data + InitInp%UA_Flag = InputFileData%AFAeroMod == AFAeroMod_BL_unsteady + InitInp%UAMod = InputFileData%UAMod + InitInp%Flookup = InputFileData%Flookup + InitInp%a_s = InputFileData%SpdSound + + ! Copy the mesh over for InitInp to FVW. We would not need to copy this if we decided to break the Framework + ! by passing u_AD%BladeMotion directly into FVW_Init, but nothing is really gained by doing that. + ALLOCATE( InitInp%WingsMesh(p%NumBlades), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat ( ErrID_Fatal, 'Could not allocate InitInp%WingsMesh (meshes)', ErrStat,ErrMsg,RoutineName ) + RETURN + END IF + DO IB = 1, p%NumBlades + CALL MeshCopy ( SrcMesh = u_AD%BladeMotion(IB) & + ,DestMesh = InitInp%WingsMesh(IB) & + ,CtrlCode = MESH_COUSIN & + ,Orientation = .TRUE. & + ,TranslationVel = .TRUE. & + ,RotationVel = .TRUE. & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 ) + CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + ENDDO + + ! NOTE: not passing p%AFI at present. We are not storing it in FVW's parameters. + call FVW_Init(p%AFI, InitInp, u, p%FVW, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) + CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set the size of the input and xd arrays for passing wind info to FVW. + if (ALLOCATED(m%r_wind)) then + call AllocAry(u_AD%InflowWakeVel, 3, size(m%r_wind,DIM=2), 'InflowWakeVel', ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + + if (.not. equalRealNos(Interval, p%DT) ) & + call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_FVWmodule(); this is not allowed yet.", ErrStat2, ErrMsg2, RoutineName) + +contains subroutine Cleanup() - call BEMT_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ) - call BEMT_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) + call FVW_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ) + call FVW_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) end subroutine Cleanup - -END SUBROUTINE Init_BEMTmodule +END SUBROUTINE Init_FVWmodule !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine calculates the tower loads for the AeroDyn TowerLoad output mesh. SUBROUTINE ADTwr_CalcOutput(p, u, m, y, ErrStat, ErrMsg ) @@ -2116,6 +2721,110 @@ SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) END SUBROUTINE TwrInfl !---------------------------------------------------------------------------------------------------------------------------------- +!> Calculate the tower influence on a array of points `Positions` (3xn) +!! The subroutine has side effecs and modifies the inflow +!! Relies heavily (i.e. unfortunate copy pasting), on TwrInfl +SUBROUTINE TwrInflArray( p, u, m, Positions, Inflow, ErrStat, ErrMsg ) + 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 + real(ReKi), dimension(:,:), INTENT(IN ) :: Positions !< Positions where tower influence is to be computed + real(ReKi), dimension(:,:), INTENT(INOUT) :: Inflow !< Undisturbed inflow (in) -> disturbed inflow (out) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! local variables + real(ReKi) :: xbar ! local x^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius + real(ReKi) :: ybar ! local y^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius + real(ReKi) :: zbar ! local z^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius + real(ReKi) :: theta_tower_trans(3,3) ! transpose of local tower orientation expressed as a DCM + real(ReKi) :: TwrCd ! local tower drag coefficient + 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) :: 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 + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'TwrInflArray' + ErrStat = ErrID_None + ErrMsg = "" + + ! 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,TwrClrnc,TwrDiam,found,denom,u_TwrPotent,v_TwrPotent,u_TwrShadow,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, 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, TwrDiam) + end if + TwrClrnc = TwoNorm(r_TowerBlade) - 0.5_ReKi*TwrDiam + + 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 + + end if + else + u_TwrPotent = 0.0_ReKi + v_TwrPotent = 0.0_ReKi + end if + + if ( p%TwrShadow .and. 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 + else + u_TwrShadow = 0.0_ReKi + end if + else + u_TwrShadow = 0.0_ReKi + end if + + 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 +!---------------------------------------------------------------------------------------------------------------------------------- !> 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, TwrClrnc, ErrStat, ErrMsg) @@ -2431,6 +3140,206 @@ END SUBROUTINE TwrInfl_NearestPoint !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdu. + TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with + !! respect to the inputs (u) [intent in to avoid deallocation] + ! local variables + TYPE(AD_OutputType) :: y_p + TYPE(AD_OutputType) :: y_m + TYPE(AD_ContinuousStateType) :: x_copy + TYPE(AD_DiscreteStateType) :: xd_copy + TYPE(AD_ConstraintStateType) :: z_copy + TYPE(AD_OtherStateType) :: OtherState_copy + TYPE(AD_InputType) :: u_perturb(1) + REAL(R8Ki) :: delta_p, delta_m ! delta change in input + INTEGER(IntKi) :: i, j, k, n + + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_JacobianPInput' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! get OP values here: + !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + if ( p%FrozenWake ) then + ! compare arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) + m%BEMT%UseFrozenWake = .true. + end if + + + ! make a copy of the inputs to perturb + call AD_CopyInput( u, u_perturb(1), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + + IF ( PRESENT( dYdu ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + + ! allocate dYdu + if (.not. allocated(dYdu) ) then + call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + + + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! make a copy of the states to perturb + call AD_CopyContState( x, x_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + do i=1,size(p%Jac_u_indx,1) + + ! get u_op + delta_p u + call AD_CopyInput( u, u_perturb(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call Perturb_u( p, i, 1, u_perturb(1), delta_p ) + + call AD_CopyContState( x, x_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + call AD_UpdateStates( t, 1, u_perturb, (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! compute y at u_op + delta_p u + call AD_CalcOutput( t, u_perturb(1), p, x_copy, xd_copy, z_copy, OtherState_copy, y_p, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get u_op - delta_m u + call AD_CopyInput( u, u_perturb(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call Perturb_u( p, i, -1, u_perturb(1), delta_m ) + + call AD_CopyContState( x, x_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call AD_UpdateStates( t, 1, u_perturb, (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + ! compute y at u_op - delta_m u + call AD_CalcOutput( t, u_perturb(1), p, x_copy, xd_copy, z_copy, OtherState_copy, y_m, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get central difference: + call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) + + end do + + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + END IF + + IF ( PRESENT( dXdu ) ) THEN + if (allocated(dXdu)) deallocate(dXdu) + END IF + + IF ( PRESENT( dXddu ) ) THEN + if (allocated(dXddu)) deallocate(dXddu) + END IF + + IF ( PRESENT( dZdu ) ) THEN + if (allocated(dZdu)) deallocate(dZdu) + END IF + + call cleanup() +contains + subroutine cleanup() + m%BEMT%UseFrozenWake = .false. + + call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call AD_DestroyContState( x_copy, ErrStat2, ErrMsg2) + call AD_DestroyDiscState( xd_copy, ErrStat2, ErrMsg2) + call AD_DestroyConstrState( z_copy, ErrStat2, ErrMsg2) + call AD_DestroyOtherState( OtherState_copy, ErrStat2, ErrMsg2) + + call AD_DestroyInput( u_perturb(1), ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE AD_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. +SUBROUTINE AD_JacobianPInput_orig( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +! This routine should be used instead of AD_JacobianPInput iff `OLD_AD_LINEAR` is defined in the FAST glue code. !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -2463,7 +3372,8 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_InputType) :: u_perturb REAL(R8Ki) :: delta_p, delta_m ! delta change in input INTEGER(IntKi) :: i, j, k, n - logical :: ValidInput + logical :: ValidInput_p + logical :: ValidInput_m integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP @@ -2536,13 +3446,13 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_p = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_p) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 + delta_p = 0.0_R8Ki end if @@ -2559,14 +3469,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_m = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_m) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_R8Ki)) then + delta_m = 0.0_R8Ki + if (.not. ValidInput_p) then call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) return @@ -2636,13 +3546,13 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_p = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_p) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 + delta_p = 0.0_R8Ki end if @@ -2659,14 +3569,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_m = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_m) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_R8Ki)) then + delta_m = 0.0_R8Ki + if (.not. ValidInput_p) then call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) return @@ -2716,7 +3626,7 @@ subroutine cleanup() call AD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup -END SUBROUTINE AD_JacobianPInput +END SUBROUTINE AD_JacobianPInput_orig !---------------------------------------------------------------------------------------------------------------------------------- !> 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. @@ -2923,8 +3833,6 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat ErrStat = ErrID_None ErrMsg = '' - -!bjj: how do I figure out if F is 0??? In that case, need to se dY/dz = 0 and dZ/dz = 1 {and need to ask jmj if this is the whole matrix or just a row/column where it applies} ! get OP values here: !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) @@ -3238,7 +4146,7 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end do index = index - 1 - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do @@ -3300,8 +4208,8 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts ! WriteOutput values + p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values do k=1,p%NumBlades p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node @@ -3324,7 +4232,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) end do ! InitOut%RotFrame_y(indx_last:indx_next-1) = .true. ! The mesh fields are in the global frame, so are not in the rotating frame - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+indx_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do @@ -3384,6 +4292,12 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) end do + do i=1,p%BldNd_TotNumOuts + InitOut%RotFrame_y(i+p%NumOuts+indx_next-1) = .true. + !AbsCant, AbsToe, AbsTwist should probably be set to .false. + end do + + deallocate(AllOut) END SUBROUTINE Init_Jacobian_y @@ -3677,13 +4591,8 @@ SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - INTEGER :: fieldIndx INTEGER :: node - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: angles(3) fieldIndx = p%Jac_u_indx(n,2) node = p%Jac_u_indx(n,3) @@ -3693,69 +4602,47 @@ SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) ! determine which mesh we're trying to perturb and perturb the input: SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign + CASE ( 1) !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; + u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign CASE ( 2) !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%TowerMotion%Orientation(:,:,node) = matmul(u%TowerMotion%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE ( 3) !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - u%TowerMotion%TranslationVel( fieldIndx,node) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign + u%TowerMotion%TranslationVel( fieldIndx,node ) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign CASE ( 4) !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign CASE ( 5) !Module/Mesh/Field: u%HubMotion%Orientation = 5; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%HubMotion%Orientation(:,:,node) = matmul(u%HubMotion%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE ( 6) !Module/Mesh/Field: u%HubMotion%RotationVel = 6; u%HubMotion%RotationVel(fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign CASE ( 7) !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(1)%Orientation(:,:,node) = matmul(u%BladeRootMotion(1)%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + CASE ( 8) !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(2)%Orientation(:,:,node) = matmul(u%BladeRootMotion(2)%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + CASE ( 9) !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(3)%Orientation(:,:,node) = matmul(u%BladeRootMotion(3)%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE (10) !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign + u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign CASE (11) !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(1)%Orientation(:,:,node) = matmul(u%BladeMotion(1)%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE (12) !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign + u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign CASE (13) !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 13; - u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign + u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign CASE (14) !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 14; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(2)%Orientation(:,:,node) = matmul(u%BladeMotion(2)%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE (15) !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 15; u%BladeMotion(2)%TranslationVel(fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign CASE (16) !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 16; - u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign + u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign CASE (17) !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 17; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(3)%Orientation(:,:,node) = matmul(u%BladeMotion(3)%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE (18) !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 18; u%BladeMotion(3)%TranslationVel(fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign @@ -3797,7 +4684,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta_p, delta_m, dY) end do - do k=1,p%NumOuts + do k=1,p%NumOuts + p%BldNd_TotNumOuts dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) end do @@ -3879,7 +4766,7 @@ FUNCTION CheckBEMTInputPerturbations( p, m ) RESULT(ValidPerturb) do k=1,p%NumBlades do j=1,p%NumBlNds - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0: + ! don't allow the input perturbations to change Vx or Vy so that Vx=0 and Vy=0: if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .and. EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then ValidPerturb = .false. return diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 new file mode 100644 index 0000000000..fc4c73684c --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -0,0 +1,1291 @@ +! This module is an add on to AeroDyn 15 to allow output of Aerodynamic data at each blade node. +! +! Copyright 2016 Envision Energy +! +MODULE AeroDyn_AllBldNdOuts_IO + + USE NWTC_Library + USE NWTC_LAPACK + USE AeroDyn_Types + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: AllBldNdOuts_InitOut + PUBLIC :: Calc_WriteAllBldNdOutput + PUBLIC :: AllBldNdOuts_SetParameters + + + ! 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 + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 02-Jul-2020 11:33:13. + + + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + + + ! Blade: + + INTEGER(IntKi), PARAMETER :: BldNd_VUndx = 1 + INTEGER(IntKi), PARAMETER :: BldNd_VUndy = 2 + INTEGER(IntKi), PARAMETER :: BldNd_VUndz = 3 + INTEGER(IntKi), PARAMETER :: BldNd_VDisx = 4 + INTEGER(IntKi), PARAMETER :: BldNd_VDisy = 5 + INTEGER(IntKi), PARAMETER :: BldNd_VDisz = 6 + INTEGER(IntKi), PARAMETER :: BldNd_STVx = 7 + INTEGER(IntKi), PARAMETER :: BldNd_STVy = 8 + INTEGER(IntKi), PARAMETER :: BldNd_STVz = 9 + INTEGER(IntKi), PARAMETER :: BldNd_VRel = 10 + INTEGER(IntKi), PARAMETER :: BldNd_DynP = 11 + INTEGER(IntKi), PARAMETER :: BldNd_Re = 12 + INTEGER(IntKi), PARAMETER :: BldNd_M = 13 + INTEGER(IntKi), PARAMETER :: BldNd_Vindx = 14 + INTEGER(IntKi), PARAMETER :: BldNd_Vindy = 15 + INTEGER(IntKi), PARAMETER :: BldNd_AxInd = 16 + INTEGER(IntKi), PARAMETER :: BldNd_TnInd = 17 + INTEGER(IntKi), PARAMETER :: BldNd_Alpha = 18 + INTEGER(IntKi), PARAMETER :: BldNd_Theta = 19 + INTEGER(IntKi), PARAMETER :: BldNd_Phi = 20 + INTEGER(IntKi), PARAMETER :: BldNd_Curve = 21 + INTEGER(IntKi), PARAMETER :: BldNd_Cl = 22 + INTEGER(IntKi), PARAMETER :: BldNd_Cd = 23 + INTEGER(IntKi), PARAMETER :: BldNd_Cm = 24 + INTEGER(IntKi), PARAMETER :: BldNd_Cx = 25 + INTEGER(IntKi), PARAMETER :: BldNd_Cy = 26 + INTEGER(IntKi), PARAMETER :: BldNd_Cn = 27 + INTEGER(IntKi), PARAMETER :: BldNd_Ct = 28 + INTEGER(IntKi), PARAMETER :: BldNd_Fl = 29 + INTEGER(IntKi), PARAMETER :: BldNd_Fd = 30 + INTEGER(IntKi), PARAMETER :: BldNd_Mm = 31 + INTEGER(IntKi), PARAMETER :: BldNd_Fx = 32 + INTEGER(IntKi), PARAMETER :: BldNd_Fy = 33 + INTEGER(IntKi), PARAMETER :: BldNd_Fn = 34 + INTEGER(IntKi), PARAMETER :: BldNd_Ft = 35 + INTEGER(IntKi), PARAMETER :: BldNd_Clrnc = 36 + INTEGER(IntKi), PARAMETER :: BldNd_Vx = 37 + INTEGER(IntKi), PARAMETER :: BldNd_Vy = 38 + INTEGER(IntKi), PARAMETER :: BldNd_GeomPhi = 39 + INTEGER(IntKi), PARAMETER :: BldNd_Chi = 40 + INTEGER(IntKi), PARAMETER :: BldNd_UA_Flag = 41 + INTEGER(IntKi), PARAMETER :: BldNd_CpMin = 42 + INTEGER(IntKi), PARAMETER :: BldNd_SgCav = 43 + INTEGER(IntKi), PARAMETER :: BldNd_SigCr = 44 + INTEGER(IntKi), PARAMETER :: BldNd_Gam = 45 + INTEGER(IntKi), PARAMETER :: BldNd_Cl_Static = 46 + INTEGER(IntKi), PARAMETER :: BldNd_Cd_Static = 47 + INTEGER(IntKi), PARAMETER :: BldNd_Cm_Static = 48 + INTEGER(IntKi), PARAMETER :: BldNd_Uin = 49 + INTEGER(IntKi), PARAMETER :: BldNd_Uit = 50 + INTEGER(IntKi), PARAMETER :: BldNd_Uir = 51 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 51 + +!End of code generated by Matlab script +! =================================================================================================== + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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, InputFileData, ErrStat, ErrMsg ) + + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AD_InputFile), 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 + + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(16) :: ChanPrefix ! Name prefix (AB#N###) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Warn if we will run into issues with more than 99 nodes. + IF (p%NumBlNds > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + ! NOTE: we populate invalid names as well (some names are not valid outputs for certain configurations). That means we will have zeros in those values. + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + ! Create the name prefix: + WRITE (TmpChar,'(I3.3)') IdxNode ! 3 digit number + ChanPrefix = 'AB' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) ! // '_' ! note that I added an "AB" to indicate "Aero B1" in case of confusion with structural nodal outputs with the same name + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = trim(ChanPrefix) // p%BldNd_OutParam(IdxChan)%Name + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + + ENDDO + ENDDO + + ENDDO + +END SUBROUTINE AllBldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is channel:blade:node (node iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +!! +!! NOTE: the equations here came from the output section of AeroDyn_IO.f90. If anything changes in there, it needs to be reflected +!! here. + +SUBROUTINE Calc_WriteAllBldNdOutput( p, u, m, y, OtherState, Indx, ErrStat, ErrMsg ) + TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AD_InputType), INTENT(IN ) :: u ! inputs + TYPE(AD_MiscVarType), INTENT(IN ) :: m ! misc variables + TYPE(AD_OutputType), INTENT(INOUT) :: y ! outputs (updates y%WriteOutput) + TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState ! other states + INTEGER, INTENT(IN ) :: Indx ! index into m%BEMT_u(Indx) array; 1=t and 2=t+dt (but not checked here) + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + + INTEGER(IntKi) :: OutIdx ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' + REAL(ReKi) :: ct, st ! cosine, sine of theta + REAL(ReKi) :: cp, sp ! cosine, sine of phi + real(ReKi) :: M_ph(3,3) ! Transformation from hub to "blade-rotor-plane": n,t,r (not the same as AeroDyn) + real(ReKi) :: M_pg(3,3,p%NumBlades) ! Transformation from global to "blade-rotor-plane" (n,t,r), with same x at hub coordinate system + real(ReKi) :: psi_hub ! Azimuth wrt hub + real(ReKi) :: Vind_g(3) ! Induced velocity vector in global coordinates + real(ReKi) :: Vind_s(3) ! Induced velocity vector in section coordinates (AeroDyn "x-y") + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + ! Precalculate the M_ph matrix -- no reason to recalculate for each output + DO IdxBlade=1,p%NumBlades + psi_hub = TwoPi*(real(IdxBlade-1,ReKi))/real(p%NumBlades,ReKi) + M_ph(1,1:3) = (/ 1.0_ReKi, 0.0_ReKi , 0.0_ReKi /) + M_ph(2,1:3) = (/ 0.0_ReKi, cos(psi_hub), sin(psi_hub) /) + M_ph(3,1:3) = (/ 0.0_ReKi,-sin(psi_hub), cos(psi_hub) /) + M_pg(1:3,1:3,IdxBlade) = matmul(M_ph, u%HubMotion%Orientation(1:3,1:3,1) ) + ENDDO + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + OutIdx = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + + ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) + ! Logic and mathematics used here come from Calc_WriteOutput + DO IdxChan=1,p%BldNd_NumOuts + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (0) ! Invalid channel + ! We still have headers for invalid channels. Need to account for that + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + CYCLE + + ! ***** Undisturbed wind velocity in local blade coord system ***** + CASE ( BldNd_VUndx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + + CASE ( BldNd_VUndy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VUndz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + + + ! ***** Disturbed wind velocity in the local blade coordinate system ***** + CASE ( BldNd_VDisx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VDisy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VDisz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! ***** Structural translational velocity in the local blade coordinate system ***** + CASE ( BldNd_STVx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_STVy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_STVz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Relative wind speed + CASE ( BldNd_VRel ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Vrel(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Vrel(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + ! Dynamic pressure + CASE ( BldNd_DynP ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.5 * p%airDens * m%BEMT_y%Vrel(IdxNode,IdxBlade)**2 + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.5 * p%airDens * m%FVW%BN_Vrel(IdxNode,IdxBlade)**2 + OutIdx = OutIdx + 1 + END DO + END DO + endif + + ! Reynolds number (in millions) + CASE ( BldNd_Re ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = p%BEMT%chord(IdxNode,IdxBlade) * m%BEMT_y%Vrel(IdxNode,IdxBlade) / p%KinVisc / 1.0E6 + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Re(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + ! Mach number + CASE ( BldNd_M ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Vrel(IdxNode,IdxBlade) / p%SpdSound + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Vrel(IdxNode,IdxBlade) / p%SpdSound + OutIdx = OutIdx + 1 + END DO + END DO + endif + + + + ! Axial and tangential induced wind velocity + CASE ( BldNd_Vindx ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = - m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade) * m%BEMT_y%axInduction( IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = -m%FVW%BN_UrelWind_s(1,IdxNode,IdxBlade) * m%FVW%BN_AxInd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Vindy ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade) * m%BEMT_y%tanInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_UrelWind_s(2,IdxNode,IdxBlade) * m%FVW%BN_TanInd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + + ! Axial and tangential induction factors + CASE ( BldNd_AxInd ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%axInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_AxInd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_TnInd ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%tanInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_TanInd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + + ! AoA, pitch+twist angle, inflow angle, and curvature angle + CASE ( BldNd_Alpha ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = Rad2M180to180Deg( m%BEMT_y%phi(IdxNode,IdxBlade) - m%BEMT_u(Indx)%theta(IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_alpha(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Theta ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%PitchAndTwist(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Phi ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%phi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) =m%FVW%BN_phi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Curve ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%Curve(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds +!NOT available in FVW yet + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + endif + + + ! Lift force, drag force, pitching moment coefficients + CASE ( BldNd_Cl ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cl(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Cl(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Cd ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Cd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Cm ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cm(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Cm(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + ! Normal force (to plane), tangential force (to plane) coefficients + CASE ( BldNd_Cx ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Cx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Cy ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_Cy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + ! Normal force (to chord), and tangential force (to chord) coefficients + CASE ( BldNd_Cn ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%BEMT_y%Cx(IdxNode,IdxBlade)*ct + m%BEMT_y%Cy(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! cos(theta) + st=sin(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! sin(theta) + y%WriteOutput( OutIdx ) = m%FVW%BN_Cx(IdxNode,IdxBlade)*ct + m%FVW%BN_Cy(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Ct ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = -m%BEMT_y%Cx(IdxNode,IdxBlade)*st + m%BEMT_y%Cy(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! cos(theta) + st=sin(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! sin(theta) + y%WriteOutput( OutIdx ) = -m%FVW%BN_Cx(IdxNode,IdxBlade)*st + m%FVW%BN_Cy(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + endif + + + ! Lift force, drag force, pitching moment + CASE ( BldNd_Fl ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%BEMT_y%phi(IdxNode,IdxBlade)) + sp=sin(m%BEMT_y%phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*cp - m%Y(IdxNode,IdxBlade)*sp + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%FVW%BN_phi(IdxNode,IdxBlade)) + sp=sin(m%FVW%BN_phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*cp - m%Y(IdxNode,IdxBlade)*sp + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Fd ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%BEMT_y%phi(IdxNode,IdxBlade)) + sp=sin(m%BEMT_y%phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*sp + m%Y(IdxNode,IdxBlade)*cp + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%FVW%BN_phi(IdxNode,IdxBlade)) + sp=sin(m%FVW%BN_phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*sp + m%Y(IdxNode,IdxBlade)*cp + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Mm ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%M(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to plane), tangential force (to plane) + CASE ( BldNd_Fx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Fy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = -m%Y(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to chord), and tangential force (to chord) per unit length + CASE ( BldNd_Fn ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*ct - m%Y(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! cos(theta) + st=sin(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! sin(theta) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*ct - m%Y(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Ft ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = -m%X(IdxNode,IdxBlade)*st - m%Y(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! cos(theta) + st=sin(m%FVW%PitchAndTwist(IdxNode,IdxBlade)) ! sin(theta) + y%WriteOutput( OutIdx ) = -m%X(IdxNode,IdxBlade)*st - m%Y(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + endif + + ! Tower clearance (requires tower influence calculation): + CASE ( BldNd_Clrnc ) + if (.not. allocated(m%TwrClrnc)) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%TwrClrnc(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + end if + + + CASE ( BldNd_Vx ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = -m%FVW%BN_UrelWind_s(1,IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_Vy ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%FVW%BN_UrelWind_s(2,IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_GeomPhi ) + if (p%WakeMod /= WakeMod_FVW) then + if (allocated(OtherState%BEMT%ValidPhi)) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + if (OtherState%BEMT%ValidPhi(IdxNode,IdxBlade)) then + y%WriteOutput( OutIdx ) = 0.0_ReKi + else + y%WriteOutput( OutIdx ) = 1.0_ReKi + end if + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 1.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + end if + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.0_ReKi ! Not valid for FVW + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_chi ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%chi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds +!NOT available in FVW yet + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + endif + + CASE ( BldNd_UA_Flag ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + IF ( OtherState%BEMT%UA_Flag(IdxNode, IdxBlade) ) THEN + y%WriteOutput( OutIdx ) = 1.0_ReKi + ELSE + y%WriteOutput( OutIdx ) = 0.0_ReKi + ENDIF + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + IF ( OtherState%FVW%UA_Flag(IdxNode, IdxBlade) ) THEN + y%WriteOutput( OutIdx ) = 1.0_ReKi + ELSE + y%WriteOutput( OutIdx ) = 0.0_ReKi + ENDIF + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + ! CpMin + CASE ( BldNd_CpMin ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = m%BEMT_y%Cpmin(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes +!NOT available in FVW yet + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + ! Cavitation + CASE ( BldNd_SgCav ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = m%SigmaCavit(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + ENDDO + ENDDO + + CASE ( BldNd_SigCr ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = m%SigmaCavitCrit(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + ENDDO + ENDDO + + ! circulation on blade + CASE ( BldNd_Gam ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = 0.5_ReKi * p%BEMT%chord(IdxNode,IdxBlade) * m%BEMT_y%Vrel(IdxNode,IdxBlade) * m%BEMT_y%Cl(IdxNode,IdxBlade) ! "Gam" [m^2/s] + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = 0.5_ReKi * p%FVW%Chord(IdxNode,IdxBlade) * m%FVW%BN_Vrel(IdxNode,IdxBlade) * m%FVW%BN_Cl(IdxNode,IdxBlade) ! "Gam" [m^2/s] + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + + !================================================ + ! Static portion of Cl, Cd, Cm (ignoring unsteady effects) + ! Cl_Static + CASE ( BldNd_Cl_Static ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes +!NOT available in BEMT/DBEMT yet + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = m%FVW%BN_Cl_Static(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + ! Cd_Static + CASE ( BldNd_Cd_Static ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes +!NOT available in BEMT/DBEMT yet + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = m%FVW%BN_Cd_Static(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + ! Cm_Static + CASE ( BldNd_Cm_Static ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes +!NOT available in BEMT/DBEMT yet + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = m%FVW%BN_Cm_Static(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + + + !================================================ + ! Inductions in polar rotating hub coordinates + ! Axial induction, polar rotating hub coordinates + CASE ( BldNd_Uin ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + Vind_s = (/ -m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade)*m%BEMT_y%axInduction(IdxNode,IdxBlade), m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade)*m%BEMT_y%tanInduction(IdxNode,IdxBlade), 0.0_ReKi /) + Vind_g = matmul(Vind_s, m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = dot_product(M_pg(1,1:3,IdxBlade), Vind_g(1:3) ) ! Uihn, hub normal + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = dot_product(M_pg(1,1:3,IdxBlade), m%FVW_y%Vind(1:3,IdxNode,IdxBlade) ) ! Uihn, hub normal + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + ! Tangential induction, polar rotating hub coordinates + CASE ( BldNd_Uit ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + Vind_s = (/ -m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade)*m%BEMT_y%axInduction(IdxNode,IdxBlade), m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade)*m%BEMT_y%tanInduction(IdxNode,IdxBlade), 0.0_ReKi /) + Vind_g = matmul(Vind_s, m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = dot_product(M_pg(2,1:3,IdxBlade), Vind_g(1:3) ) ! Uiht, hub tangential + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = dot_product(M_pg(2,1:3,IdxBlade), m%FVW_y%Vind(1:3,IdxNode,IdxBlade) ) ! Uiht, hub tangential + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + ! Radial induction, polar rotating hub coordinates + CASE ( BldNd_Uir ) + if (p%WakeMod /= WakeMod_FVW) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + Vind_s = (/ -m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade)*m%BEMT_y%axInduction(IdxNode,IdxBlade), m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade)*m%BEMT_y%tanInduction(IdxNode,IdxBlade), 0.0_ReKi /) + Vind_g = matmul(Vind_s, m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = dot_product(M_pg(3,1:3,IdxBlade), Vind_g(1:3) ) ! Uihr, hub radial + OutIdx = OutIdx + 1 + ENDDO + ENDDO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes + y%WriteOutput( OutIdx ) = dot_product(M_pg(3,1:3,IdxBlade), m%FVW_y%Vind(1:3,IdxNode,IdxBlade) ) ! Uihr, hub radial + OutIdx = OutIdx + 1 + ENDDO + ENDDO + endif + + + END SELECT + + END DO ! each channel + + +END SUBROUTINE Calc_WriteAllBldNdOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates and sets the parameters for the nodal outputs. +SUBROUTINE AllBldNdOuts_SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + + ! Passed variables: + + TYPE(AD_InitInputType), intent(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below + TYPE(AD_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + character(*), parameter :: RoutineName = 'AllBldNdOuts_SetParameters' + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Check if the requested blades exist + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBlades) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBlades))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = 0_IntKi + ELSE + p%BldNd_BladesOut = InputFileData%BldNd_BladesOut + ENDIF + + + ! Check if the requested blade nodes are valid + ! InputFileData%BldNd_BlOutNd + + + ! Set the parameter to store number of requested Blade Node output sets + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + + ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) + p%BldNd_TotNumOuts = p%BldNd_NumOuts*p%NumBlNds*p%BldNd_BladesOut ! p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) + +! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd +! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes +! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) +! ! -- copy values over +! +! ! Temporary workaround here: +! ALLOCATE ( p%BldNd_BlOutNd(1:p%NumBlNds) , STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBlNds ! put all nodes in the list +! p%BldNd_BlOutNd(i) = i +! ENDDO + + +! ! Check if the requested blades are actually in use: +! ! TODO: this value is not read in by the input file reading yet, so setting to all blades +! ! -- check if list handed in is of blades that exist (not sure this is ever checked) +! ! -- copy values over +! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBlades), STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBlades ! put all blades in the list +! p%BldNd_BladesOut(i) = i +! ENDDO + + if (p%BldNd_TotNumOuts > 0) then + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat, ErrMsg ) ! requires: p%NumOuts, p%numBlades, p%NumBlNds, p%NumTwrNds; sets: p%BldNdOutParam. + if (ErrStat >= AbortErrLev) return + end if + + + +END SUBROUTINE AllBldNdOuts_SetParameters + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 02-Jul-2020 11:33:13. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(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(51) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ALPHA ","AXIND ","CD ","CD_STATIC","CHI ","CL ","CLRNC ","CL_STATIC", & + "CM ","CM_STATIC","CN ","CPMIN ","CT ","CURVE ","CX ","CY ", & + "DYNP ","FD ","FL ","FN ","FT ","FX ","FY ","GAM ", & + "GEOMPHI ","M ","MM ","PHI ","RE ","SGCAV ","SIGCR ","STVX ", & + "STVY ","STVZ ","THETA ","TNIND ","UA_FLAG ","UIN ","UIR ","UIT ", & + "VDISX ","VDISY ","VDISZ ","VINDX ","VINDY ","VREL ","VUNDX ","VUNDY ", & + "VUNDZ ","VX ","VY "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(51) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_Alpha , BldNd_AxInd , BldNd_Cd , BldNd_Cd_Static , BldNd_Chi , BldNd_Cl , BldNd_Clrnc , BldNd_Cl_Static , & + BldNd_Cm , BldNd_Cm_Static , BldNd_Cn , BldNd_CpMin , BldNd_Ct , BldNd_Curve , BldNd_Cx , BldNd_Cy , & + BldNd_DynP , BldNd_Fd , BldNd_Fl , BldNd_Fn , BldNd_Ft , BldNd_Fx , BldNd_Fy , BldNd_Gam , & + BldNd_GeomPhi , BldNd_M , BldNd_Mm , BldNd_Phi , BldNd_Re , BldNd_SgCav , BldNd_SigCr , BldNd_STVx , & + BldNd_STVy , BldNd_STVz , BldNd_Theta , BldNd_TnInd , BldNd_UA_Flag , BldNd_Uin , BldNd_Uir , BldNd_Uit , & + BldNd_VDisx , BldNd_VDisy , BldNd_VDisz , BldNd_Vindx , BldNd_Vindy , BldNd_VRel , BldNd_VUndx , BldNd_VUndy , & + BldNd_VUndz , BldNd_Vx , BldNd_Vy /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(51) = (/ & ! This lists the units corresponding to the allowed parameters + "(deg) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(m) ","(-) ", & + "(-) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s)", & + "(1/0) ","(-) ","(N-m/m)","(deg) ","(-) ","(-) ","(-) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + + ! The following are valid only for BEMT/DBEMT + if (p%WakeMod /= WakeMod_FVW) then + InvalidOutput( BldNd_Cl_Static ) = .true. + InvalidOutput( BldNd_Cd_Static ) = .true. + InvalidOutput( BldNd_Cm_Static ) = .true. + else + ! The following are invalid for free vortex wake + InvalidOutput( BldNd_Chi ) = .true. + InvalidOutput( BldNd_Curve ) = .true. + InvalidOutput( BldNd_CpMin ) = .true. + endif + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%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 = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** +END MODULE AeroDyn_AllBldNdOuts_IO diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 2ca6fe5fc6..c29920e573 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -44,8 +44,8 @@ subroutine Dvr_Init(DvrData,errStat,errMsg ) CHARACTER(1000) :: inputFile ! String to hold the file name. CHARACTER(200) :: git_commit ! String containing the current git commit hash + CHARACTER(20) :: FlagArg ! flag argument from command line - TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'AeroDyn Driver', '', '' ) ! The version number of this program. ErrStat = ErrID_None ErrMsg = "" @@ -53,30 +53,18 @@ subroutine Dvr_Init(DvrData,errStat,errMsg ) DvrData%OutFileData%unOutFile = -1 - CALL NWTC_Init() + CALL NWTC_Init( ProgNameIN=version%Name ) + + InputFile = "" ! initialize to empty string to make sure it's input from the command line + CALL CheckArgs( InputFile, Flag=FlagArg ) + IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() + ! Display the copyright notice - CALL DispCopyrightLicense( version ) + CALL DispCopyrightLicense( version%Name ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running - CALL WrScr( ' Running '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) - - InputFile = "" ! initialize to empty string to make sure it's input from the command line - CALL CheckArgs( InputFile, ErrStat2 ) - IF (LEN_TRIM(InputFile) == 0) THEN ! no input file was specified - call SetErrStat(ErrID_Fatal, 'The required input file was not specified on the command line.', ErrStat, ErrMsg, RoutineName) - - !bjj: if people have compiled themselves, they should be able to figure out the file name, right? - IF (BITS_IN_ADDR==32) THEN - CALL NWTC_DisplaySyntax( InputFile, 'AeroDyn_Driver_Win32.exe' ) - ELSEIF( BITS_IN_ADDR == 64) THEN - CALL NWTC_DisplaySyntax( InputFile, 'AeroDyn_Driver_x64.exe' ) - ELSE - CALL NWTC_DisplaySyntax( InputFile, 'AeroDyn_Driver.exe' ) - END IF - - return - END IF + CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) ! Read the AeroDyn driver input file call Dvr_ReadInputFile(inputFile, DvrData, errStat2, errMsg2 ) @@ -262,7 +250,7 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) AD%u(1)%HubMotion%RotationVel( :,1) = AD%u(1)%HubMotion%Orientation(1,:,1) * DvrData%Cases(iCase)%RotSpeed - ! Blade root motions: + ! Blade motions: do k=1,DvrData%numBlades theta(1) = (k-1)*TwoPi/real(DvrData%numBlades,ReKi) theta(2) = DvrData%precone @@ -273,7 +261,7 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) end do !k=numBlades - ! Blade motions: + ! Blade and blade root motions: do k=1,DvrData%numBlades rotateMat = transpose( AD%u(1)%BladeRootMotion(k)%Orientation( :,:,1) ) rotateMat = matmul( rotateMat, AD%u(1)%BladeRootMotion(k)%RefOrientation( :,:,1) ) @@ -283,6 +271,14 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) rotateMat(2,2) = rotateMat(2,2) - 1.0_ReKi rotateMat(3,3) = rotateMat(3,3) - 1.0_ReKi + + position = AD%u(1)%BladeRootMotion(k)%Position(:,1) - AD%u(1)%HubMotion%Position(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationDisp(:,1) = AD%u(1)%HubMotion%TranslationDisp(:,1) + matmul( rotateMat, position ) + + position = AD%u(1)%BladeRootMotion(k)%Position(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationDisp(:,1) & + - AD%u(1)%HubMotion%Position(:,1) - AD%u(1)%HubMotion%TranslationDisp(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationVel( :,1) = cross_product( AD%u(1)%HubMotion%RotationVel(:,1), position ) + do j=1,AD%u(1)%BladeMotion(k)%nnodes position = AD%u(1)%BladeMotion(k)%Position(:,j) - AD%u(1)%HubMotion%Position(:,1) AD%u(1)%BladeMotion(k)%TranslationDisp(:,j) = AD%u(1)%HubMotion%TranslationDisp(:,1) + matmul( rotateMat, position ) @@ -462,6 +458,7 @@ subroutine Dvr_ReadInputFile(fileName, DvrData, errStat, errMsg ) call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) call ReadVar ( unIn, fileName, DvrData%OutFileData%Root, 'OutFileRoot', 'Root name for any output files', errStat2, errMsg2, UnEc ) call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) + IF ( PathIsRelative( DvrData%OutFileData%Root ) ) DvrData%OutFileData%Root = TRIM(PriPath)//TRIM(DvrData%OutFileData%Root) if (len_trim(DvrData%OutFileData%Root) == 0) then call getroot(fileName,DvrData%OutFileData%Root) end if @@ -642,7 +639,7 @@ subroutine Dvr_InitializeOutputFile( iCase, CaseData, OutFileData, errStat, errM call OpenFOutFile ( OutFileData%unOutFile, trim(outFileData%Root)//'.'//trim(num2lstr(iCase))//'.out', ErrStat, ErrMsg ) if ( ErrStat >= AbortErrLev ) return - write (OutFileData%unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim(GetNVD(version)) + write (OutFileData%unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim( version%Name ) write (OutFileData%unOutFile,'(1X,A)') trim(GetNVD(OutFileData%AD_ver)) write (OutFileData%unOutFile,'()' ) !print a blank line ! write (OutFileData%unOutFile,'(A,11(1x,A,"=",ES11.4e2,1x,A))' ) 'Case '//trim(num2lstr(iCase))//':' & diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index b6d95ded58..6233a3ec5c 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -35,6 +35,8 @@ MODULE AeroDyn_Driver_Types USE UnsteadyAero_Types USE DBEMT_Types USE BEMT_Types +USE FVW_Types +USE AeroAcoustics_Types USE AeroDyn_Types USE NWTC_Library IMPLICIT NONE @@ -194,20 +196,20 @@ SUBROUTINE AD_Dvr_PackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WndSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShearExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WndSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShearExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 END SUBROUTINE AD_Dvr_PackDvr_Case SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -223,12 +225,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -243,20 +239,20 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%WndSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShearExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WndSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE AD_Dvr_UnPackDvr_Case SUBROUTINE AD_Dvr_CopyDvr_OutputFile( SrcDvr_OutputFileData, DstDvr_OutputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -449,24 +445,24 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%unOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%runTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%runTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%unOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%outFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Root) + IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%runTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%runTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -477,12 +473,12 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -494,12 +490,12 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE AD_Dvr_PackDvr_OutputFile @@ -516,12 +512,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -576,24 +566,24 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%unOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%runTitle) - OutData%runTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%unOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%delim) + OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%outFmt) + OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Root) + OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%runTitle) + OutData%runTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -607,19 +597,12 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -634,19 +617,12 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE AD_Dvr_UnPackDvr_OutputFile @@ -1143,8 +1119,10 @@ SUBROUTINE AD_Dvr_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTime))-1 ) = PACK(InData%InputTime,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTime) + DO i1 = LBOUND(InData%InputTime,1), UBOUND(InData%InputTime,1) + DbKiBuf(Db_Xferred) = InData%InputTime(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE AD_Dvr_PackAeroDyn_Data SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1160,12 +1138,6 @@ SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1506,15 +1478,10 @@ SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%InputTime,1) i1_u = UBOUND(OutData%InputTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InputTime = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTime))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTime,1), UBOUND(OutData%InputTime,1) + OutData%InputTime(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE AD_Dvr_UnPackAeroDyn_Data SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) @@ -1690,24 +1657,24 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%AD_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%overhang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Precone - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCases - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%AD_InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%overhang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Precone + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCases + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Cases) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1792,12 +1759,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1812,24 +1773,24 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%AD_InputFile) - OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%hubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%overhang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Precone = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumCases = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%AD_InputFile) + OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%hubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%overhang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Precone = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumCases = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 09d924c45b..f6115fa23c 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -23,19 +23,23 @@ MODULE AeroDyn_IO use NWTC_Library use AeroDyn_Types use BEMTUncoupled, only : SkewMod_Uncoupled, SkewMod_PittPeters, VelocityIsZero + use AirFoilInfo, only : AFI_ComputeAirfoilCoefs + use FVW_Subs, only : FVW_AeroOuts + USE AeroDyn_AllBldNdOuts_IO implicit none type(ProgDesc), parameter :: AD_Ver = ProgDesc( 'AeroDyn', '', '' ) character(*), parameter :: AD_Nickname = 'AD' + ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters_RMurray.xlsx" Excel file. Any changes to these +! 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 16-Feb-2017 15:50:51. +! This code was generated by Write_ChckOutLst.m at 05-May-2020 06:44:07. ! Parameters related to output length (number of characters allowed in the output data headers): @@ -1226,31 +1230,58 @@ MODULE AeroDyn_IO INTEGER(IntKi), PARAMETER :: B3N7SgCav = 1165 INTEGER(IntKi), PARAMETER :: B3N8SgCav = 1166 INTEGER(IntKi), PARAMETER :: B3N9SgCav = 1167 + INTEGER(IntKi), PARAMETER :: B1N1Gam = 1168 + INTEGER(IntKi), PARAMETER :: B1N2Gam = 1169 + INTEGER(IntKi), PARAMETER :: B1N3Gam = 1170 + INTEGER(IntKi), PARAMETER :: B1N4Gam = 1171 + INTEGER(IntKi), PARAMETER :: B1N5Gam = 1172 + INTEGER(IntKi), PARAMETER :: B1N6Gam = 1173 + INTEGER(IntKi), PARAMETER :: B1N7Gam = 1174 + INTEGER(IntKi), PARAMETER :: B1N8Gam = 1175 + INTEGER(IntKi), PARAMETER :: B1N9Gam = 1176 + INTEGER(IntKi), PARAMETER :: B2N1Gam = 1177 + INTEGER(IntKi), PARAMETER :: B2N2Gam = 1178 + INTEGER(IntKi), PARAMETER :: B2N3Gam = 1179 + INTEGER(IntKi), PARAMETER :: B2N4Gam = 1180 + INTEGER(IntKi), PARAMETER :: B2N5Gam = 1181 + INTEGER(IntKi), PARAMETER :: B2N6Gam = 1182 + INTEGER(IntKi), PARAMETER :: B2N7Gam = 1183 + INTEGER(IntKi), PARAMETER :: B2N8Gam = 1184 + INTEGER(IntKi), PARAMETER :: B2N9Gam = 1185 + INTEGER(IntKi), PARAMETER :: B3N1Gam = 1186 + INTEGER(IntKi), PARAMETER :: B3N2Gam = 1187 + INTEGER(IntKi), PARAMETER :: B3N3Gam = 1188 + INTEGER(IntKi), PARAMETER :: B3N4Gam = 1189 + INTEGER(IntKi), PARAMETER :: B3N5Gam = 1190 + INTEGER(IntKi), PARAMETER :: B3N6Gam = 1191 + INTEGER(IntKi), PARAMETER :: B3N7Gam = 1192 + INTEGER(IntKi), PARAMETER :: B3N8Gam = 1193 + INTEGER(IntKi), PARAMETER :: B3N9Gam = 1194 ! Rotor: - INTEGER(IntKi), PARAMETER :: RtSpeed = 1168 - INTEGER(IntKi), PARAMETER :: RtTSR = 1169 - INTEGER(IntKi), PARAMETER :: RtVAvgxh = 1170 - INTEGER(IntKi), PARAMETER :: RtVAvgyh = 1171 - INTEGER(IntKi), PARAMETER :: RtVAvgzh = 1172 - INTEGER(IntKi), PARAMETER :: RtSkew = 1173 - INTEGER(IntKi), PARAMETER :: RtAeroFxh = 1174 - INTEGER(IntKi), PARAMETER :: RtAeroFyh = 1175 - INTEGER(IntKi), PARAMETER :: RtAeroFzh = 1176 - INTEGER(IntKi), PARAMETER :: RtAeroMxh = 1177 - INTEGER(IntKi), PARAMETER :: RtAeroMyh = 1178 - INTEGER(IntKi), PARAMETER :: RtAeroMzh = 1179 - INTEGER(IntKi), PARAMETER :: RtAeroPwr = 1180 - INTEGER(IntKi), PARAMETER :: RtArea = 1181 - INTEGER(IntKi), PARAMETER :: RtAeroCp = 1182 - INTEGER(IntKi), PARAMETER :: RtAeroCq = 1183 - INTEGER(IntKi), PARAMETER :: RtAeroCt = 1184 + INTEGER(IntKi), PARAMETER :: RtSpeed = 1195 + INTEGER(IntKi), PARAMETER :: RtTSR = 1196 + INTEGER(IntKi), PARAMETER :: RtVAvgxh = 1197 + INTEGER(IntKi), PARAMETER :: RtVAvgyh = 1198 + INTEGER(IntKi), PARAMETER :: RtVAvgzh = 1199 + INTEGER(IntKi), PARAMETER :: RtSkew = 1200 + INTEGER(IntKi), PARAMETER :: RtAeroFxh = 1201 + INTEGER(IntKi), PARAMETER :: RtAeroFyh = 1202 + INTEGER(IntKi), PARAMETER :: RtAeroFzh = 1203 + INTEGER(IntKi), PARAMETER :: RtAeroMxh = 1204 + INTEGER(IntKi), PARAMETER :: RtAeroMyh = 1205 + INTEGER(IntKi), PARAMETER :: RtAeroMzh = 1206 + INTEGER(IntKi), PARAMETER :: RtAeroPwr = 1207 + INTEGER(IntKi), PARAMETER :: RtArea = 1208 + INTEGER(IntKi), PARAMETER :: RtAeroCp = 1209 + INTEGER(IntKi), PARAMETER :: RtAeroCq = 1210 + INTEGER(IntKi), PARAMETER :: RtAeroCt = 1211 ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 1184 + INTEGER(IntKi), PARAMETER :: MaxOutPts = 1211 !End of code generated by Matlab script ! =================================================================================================== @@ -1412,19 +1443,19 @@ MODULE AeroDyn_IO B3N1Cm,B3N2Cm,B3N3Cm,B3N4Cm,B3N5Cm,B3N6Cm,B3N7Cm,B3N8Cm,B3N9Cm & /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCpmin(9, 3) = RESHAPE( (/ & ! pressure coefficient + INTEGER, PARAMETER :: BNCpmin(9, 3) = RESHAPE( (/ & ! pressure coefficient B1N1Cpmin,B1N2Cpmin,B1N3Cpmin,B1N4Cpmin,B1N5Cpmin,B1N6Cpmin,B1N7Cpmin,B1N8Cpmin,B1N9Cpmin, & B2N1Cpmin,B2N2Cpmin,B2N3Cpmin,B2N4Cpmin,B2N5Cpmin,B2N6Cpmin,B2N7Cpmin,B2N8Cpmin,B2N9Cpmin, & B3N1Cpmin,B3N2Cpmin,B3N3Cpmin,B3N4Cpmin,B3N5Cpmin,B3N6Cpmin,B3N7Cpmin,B3N8Cpmin,B3N9Cpmin & /), (/9, 3/) ) - INTEGER, PARAMETER :: BNSigCr(9, 3) = RESHAPE( (/ & ! Critical cavitation number + INTEGER, PARAMETER :: BNSigCr(9, 3) = RESHAPE( (/ & ! Critical cavitation number B1N1SigCr,B1N2SigCr,B1N3SigCr,B1N4SigCr,B1N5SigCr,B1N6SigCr,B1N7SigCr,B1N8SigCr,B1N9SigCr, & B2N1SigCr,B2N2SigCr,B2N3SigCr,B2N4SigCr,B2N5SigCr,B2N6SigCr,B2N7SigCr,B2N8SigCr,B2N9SigCr, & B3N1SigCr,B3N2SigCr,B3N3SigCr,B3N4SigCr,B3N5SigCr,B3N6SigCr,B3N7SigCr,B3N8SigCr,B3N9SigCr & /), (/9, 3/) ) - INTEGER, PARAMETER :: BNSgCav(9, 3) = RESHAPE( (/ & ! Cavitation number + INTEGER, PARAMETER :: BNSgCav(9, 3) = RESHAPE( (/ & ! Cavitation number B1N1SgCav,B1N2SgCav,B1N3SgCav,B1N4SgCav,B1N5SgCav,B1N6SgCav,B1N7SgCav,B1N8SgCav,B1N9SgCav, & B2N1SgCav,B2N2SgCav,B2N3SgCav,B2N4SgCav,B2N5SgCav,B2N6SgCav,B2N7SgCav,B2N8SgCav,B2N9SgCav, & B3N1SgCav,B3N2SgCav,B3N3SgCav,B3N4SgCav,B3N5SgCav,B3N6SgCav,B3N7SgCav,B3N8SgCav,B3N9SgCav & @@ -1490,110 +1521,71 @@ MODULE AeroDyn_IO B2N1Clrnc,B2N2Clrnc,B2N3Clrnc,B2N4Clrnc,B2N5Clrnc,B2N6Clrnc,B2N7Clrnc,B2N8Clrnc,B2N9Clrnc, & B3N1Clrnc,B3N2Clrnc,B3N3Clrnc,B3N4Clrnc,B3N5Clrnc,B3N6Clrnc,B3N7Clrnc,B3N8Clrnc,B3N9Clrnc & /), (/9, 3/) ) - + INTEGER, PARAMETER :: BNGam(9,3) = RESHAPE( (/ & ! Vorticity gamma + B1N1Gam,B1N2Gam,B1N3Gam,B1N4Gam,B1N5Gam,B1N6Gam,B1N7Gam,B1N8Gam,B1N9Gam, & + B2N1Gam,B2N2Gam,B2N3Gam,B2N4Gam,B2N5Gam,B2N6Gam,B2N7Gam,B2N8Gam,B2N9Gam, & + B3N1Gam,B3N2Gam,B3N3Gam,B3N4Gam,B3N5Gam,B3N6Gam,B3N7Gam,B3N8Gam,B3N9Gam & + /), (/9,3/) ) + INTEGER(IntKi), PARAMETER :: MaxBl = 3 ! Maximum number of blades allowed in simulation - ! model identifiers - integer(intKi), parameter :: ModelUnknown = -1 - - integer(intKi), parameter :: WakeMod_none = 0 - integer(intKi), parameter :: WakeMod_BEMT = 1 - integer(intKi), parameter :: WakeMod_DBEMT = 2 - - integer(intKi), parameter :: AFAeroMod_steady = 1 ! steady model - integer(intKi), parameter :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model - - integer(intKi), parameter :: TwrPotent_none = 0 ! none - integer(intKi), parameter :: TwrPotent_baseline = 1 ! baseline potential flow - integer(intKi), parameter :: TwrPotent_Bak = 2 ! potential flow with Bak correction - + contains - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteDbgOutput( p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - !INTEGER(intKi) :: ErrStat2 - !CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,i - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - - - ! blade outputs - do k=1,p%numBlades - - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - +!> Compute maximum radius over all blades (contains hub radius), in "projected rotor plane" +!! Solely based on AD inputs, needed for FVW since rLocal is not stored +PURE REAL(ReKi) FUNCTION Calc_MaxRadius(p, u) result(rmax) + implicit none + TYPE(AD_ParameterType), INTENT(IN ) :: p !< The module parameters + TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs + real(ReKi) :: y_hat_disk(3), z_hat_disk(3), dr_gl(3), rLocal + integer(IntKi) :: iB, j + y_hat_disk = u%HubMotion%Orientation(2,:,1) + z_hat_disk = u%HubMotion%Orientation(3,:,1) + rmax = 0.0_ReKi + do iB=1,p%numBlades do j=1,p%NumBlNds - - i = (k-1)*p%NumBlNds*23 + (j-1)*23 + 1 - - m%AllOuts( i ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( i+1 ) = m%BEMT_u(indx)%psi(k)*R2D - m%AllOuts( i+2 ) = -m%BEMT_u(indx)%Vx(j,k) - m%AllOuts( i+3 ) = m%BEMT_u(indx)%Vy(j,k) - - m%AllOuts( i+4 ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( i+5 ) = m%BEMT_y%tanInduction(j,k) - m%AllOuts( i+6 ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( i+7 ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( i+8 ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - - - m%AllOuts( i+9 ) = m%BEMT_y%Cl(j,k) - m%AllOuts( i+10 ) = m%BEMT_y%Cd(j,k) - m%AllOuts( i+11 ) = m%BEMT_y%Cm(j,k) - m%AllOuts( i+12 ) = m%BEMT_y%Cx(j,k) - m%AllOuts( i+13 ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( i+14 ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( i+15 ) = -m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( i+16 ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( i+17 ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( i+18 ) = m%M(j,k) - m%AllOuts( i+19 ) = m%X(j,k) - m%AllOuts( i+20 ) = -m%Y(j,k) - m%AllOuts( i+21 ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( i+22 ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - -END SUBROUTINE Calc_WriteDbgOutput + dr_gl = u%BladeMotion(iB)%Position(:,j) - u%HubMotion%Position(:,1) ! vector hub center to node j in global coord + rLocal = sqrt( dot_product(dr_gl, y_hat_disk)**2 + dot_product(dr_gl, z_hat_disk)**2 ) + rmax = max(rmax, rLocal) + end do !j=nodes + end do !iB=blades +END FUNCTION Calc_MaxRadius + +!> Rotor speed +PURE REAL(ReKi) FUNCTION Calc_Omega(u) + TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs + Calc_Omega = dot_product(u%HubMotion%RotationVel(:,1), u%HubMotion%Orientation(1,:,1)) +END FUNCTION Calc_Omega + +!> Mean skew angle +REAL(ReKi) FUNCTION Calc_Chi0(V_diskAvg, V_dot_x) + implicit none + REAL(ReKi), INTENT(IN ) :: V_diskAvg(3) + REAL(ReKi), INTENT(IN ) :: V_dot_x + REAL(ReKi) :: V_norm, sy + V_norm = TwoNorm( V_diskAvg ) + if ( EqualRealNos( V_norm, 0.0_ReKi ) ) then + Calc_Chi0 = 0.0_ReKi + else + ! make sure we don't have numerical issues that make the ratio outside +/-1 + sy = min( 1.0_ReKi, V_dot_x / V_norm ) + sy = max( -1.0_ReKi, sy ) + Calc_Chi0 = acos( sy ) + end if +END FUNCTION Calc_Chi0 + !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, u, m, y, OtherState, xd, indx, ErrStat, ErrMsg ) TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters TYPE(AD_InputType), INTENT(IN ) :: u ! inputs TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState ! other states at t (for DBEMT debugging) + TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState ! other states at t (for DBEMT and UA) + TYPE(AD_DiscreteStateType),INTENT(IN ) :: xd ! Discrete states integer, intent(in ) :: indx ! index into m%BEMT_u(indx) array; 1=t and 2=t+dt (but not checked here) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred @@ -1635,79 +1627,14 @@ SUBROUTINE Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat, ErrMsg ) m%AllOuts( TwNFdy( beta) ) = m%Y_Twr(j) end do ! out nodes - - ! blade outputs - do k=1,p%numBlades - m%AllOuts( BAzimuth(k) ) = m%BEMT_u(indx)%psi(k)*R2D - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do beta=1,p%NBlOuts - - j=p%BlOutNd(beta) - - - tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%InflowOnBlade(:,j,k) ) - m%AllOuts( BNVUndx(beta,k) ) = tmp(1) - m%AllOuts( BNVUndy(beta,k) ) = tmp(2) - m%AllOuts( BNVUndz(beta,k) ) = tmp(3) - - tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), m%DisturbedInflow(:,j,k) ) - m%AllOuts( BNVDisx(beta,k) ) = tmp(1) - m%AllOuts( BNVDisy(beta,k) ) = tmp(2) - m%AllOuts( BNVDisz(beta,k) ) = tmp(3) - - tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%BladeMotion(k)%TranslationVel(:,j) ) - m%AllOuts( BNSTVx( beta,k) ) = tmp(1) - m%AllOuts( BNSTVy( beta,k) ) = tmp(2) - m%AllOuts( BNSTVz( beta,k) ) = tmp(3) - - m%AllOuts( BNVrel( beta,k) ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( BNDynP( beta,k) ) = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 - m%AllOuts( BNRe( beta,k) ) = p%BEMT%chord(j,k) * m%BEMT_y%Vrel(j,k) / p%KinVisc / 1.0E6 - m%AllOuts( BNM( beta,k) ) = m%BEMT_y%Vrel(j,k) / p%SpdSound - m%AllOuts( BNVIndx(beta,k) ) = - m%BEMT_u(indx)%Vx(j,k) * m%BEMT_y%axInduction( j,k) - m%AllOuts( BNVIndy(beta,k) ) = m%BEMT_u(indx)%Vy(j,k) * m%BEMT_y%tanInduction(j,k) - - m%AllOuts( BNAxInd(beta,k) ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( BNTnInd(beta,k) ) = m%BEMT_y%tanInduction(j,k) + if (p%WakeMod /= WakeMod_FVW) then + call Calc_WriteOutput_BEMT + else + call Calc_WriteOutput_FVW + endif + - m%AllOuts( BNAlpha(beta,k) ) = Rad2M180to180Deg( m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k) ) - m%AllOuts( BNTheta(beta,k) ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( BNPhi( beta,k) ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D - - !m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cl(j,k) - !m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cd(j,k) - - m%AllOuts( BNCpmin( beta,k) ) = m%BEMT_y%Cpmin(j,k) - m%AllOuts( BNSigCr( beta,k) ) = m%SigmaCavitCrit(j,k) - m%AllOuts( BNSgCav( beta,k) ) = m%SigmaCavit(j,k) - - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cx(j,k)*cp + m%BEMT_y%Cy(j,k)*sp - m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cx(j,k)*sp - m%BEMT_y%Cy(j,k)*cp - m%AllOuts( BNCm( beta,k) ) = m%BEMT_y%Cm(j,k) - m%AllOuts( BNCx( beta,k) ) = m%BEMT_y%Cx(j,k) - m%AllOuts( BNCy( beta,k) ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( BNCn( beta,k) ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( BNCt( beta,k) ) =-m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - m%AllOuts( BNFl( beta,k) ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( BNFd( beta,k) ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( BNMm( beta,k) ) = m%M(j,k) - m%AllOuts( BNFx( beta,k) ) = m%X(j,k) - m%AllOuts( BNFy( beta,k) ) = -m%Y(j,k) - m%AllOuts( BNFn( beta,k) ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( BNFt( beta,k) ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - ! blade node tower clearance (requires tower influence calculation): if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then do k=1,p%numBlades @@ -1718,61 +1645,258 @@ SUBROUTINE Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat, ErrMsg ) end do end if - ! rotor outputs: - rmax = 0.0_ReKi - do k=1,p%NumBlades - do j=1,p%NumBlNds - rmax = max(rmax, m%BEMT_u(indx)%rLocal(j,k) ) - end do !j=nodes - end do !k=blades - - m%AllOuts( RtSpeed ) = m%BEMT_u(indx)%omega*RPS2RPM - m%AllOuts( RtArea ) = pi*rmax**2 - - tmp = matmul( u%HubMotion%Orientation(:,:,1), m%V_DiskAvg ) - m%AllOuts( RtVAvgxh ) = tmp(1) - m%AllOuts( RtVAvgyh ) = tmp(2) - m%AllOuts( RtVAvgzh ) = tmp(3) - - m%AllOuts( RtSkew ) = m%BEMT_u(indx)%chi0*R2D - - ! integrate force/moments over blades by performing mesh transfer to hub point: - force = 0.0_ReKi - moment = 0.0_ReKi - do k=1,p%NumBlades - call Transfer_Line2_to_Point( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2, u%BladeMotion(k), u%HubMotion ) - force = force + m%HubLoad%force( :,1) - moment = moment + m%HubLoad%moment(:,1) - end do - tmp = matmul( u%HubMotion%Orientation(:,:,1), force ) - m%AllOuts( RtAeroFxh ) = tmp(1) - m%AllOuts( RtAeroFyh ) = tmp(2) - m%AllOuts( RtAeroFzh ) = tmp(3) - - tmp = matmul( u%HubMotion%Orientation(:,:,1), moment ) - m%AllOuts( RtAeroMxh ) = tmp(1) - m%AllOuts( RtAeroMyh ) = tmp(2) - m%AllOuts( RtAeroMzh ) = tmp(3) - - m%AllOuts( RtAeroPwr ) = m%BEMT_u(indx)%omega * m%AllOuts( RtAeroMxh ) - - - if ( EqualRealNos( m%V_dot_x, 0.0_ReKi ) ) then - m%AllOuts( RtTSR ) = 0.0_ReKi - m%AllOuts( RtAeroCp ) = 0.0_ReKi - m%AllOuts( RtAeroCq ) = 0.0_ReKi - m%AllOuts( RtAeroCt ) = 0.0_ReKi - else - denom = 0.5*p%AirDens*m%AllOuts( RtArea )*m%V_dot_x**2 - m%AllOuts( RtTSR ) = m%BEMT_u(indx)%omega * rmax / m%V_dot_x - - m%AllOuts( RtAeroCp ) = m%AllOuts( RtAeroPwr ) / (denom * m%V_dot_x) - m%AllOuts( RtAeroCq ) = m%AllOuts( RtAeroMxh ) / (denom * rmax) - m%AllOuts( RtAeroCt ) = m%AllOuts( RtAeroFxh ) / denom - end if - !m%AllOuts( DBEMTau1 ) = OtherState%BEMT%DBEMT%tau1 +CONTAINS + subroutine Calc_WriteOutput_BEMT + ! blade outputs + do k=1,p%numBlades + m%AllOuts( BAzimuth(k) ) = m%BEMT_u(indx)%psi(k)*R2D + ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT + + do beta=1,p%NBlOuts + + j=p%BlOutNd(beta) + + tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%InflowOnBlade(:,j,k) ) + m%AllOuts( BNVUndx(beta,k) ) = tmp(1) + m%AllOuts( BNVUndy(beta,k) ) = tmp(2) + m%AllOuts( BNVUndz(beta,k) ) = tmp(3) + + tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), m%DisturbedInflow(:,j,k) ) + m%AllOuts( BNVDisx(beta,k) ) = tmp(1) + m%AllOuts( BNVDisy(beta,k) ) = tmp(2) + m%AllOuts( BNVDisz(beta,k) ) = tmp(3) + + tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%BladeMotion(k)%TranslationVel(:,j) ) + m%AllOuts( BNSTVx( beta,k) ) = tmp(1) + m%AllOuts( BNSTVy( beta,k) ) = tmp(2) + m%AllOuts( BNSTVz( beta,k) ) = tmp(3) + + m%AllOuts( BNVrel( beta,k) ) = m%BEMT_y%Vrel(j,k) + m%AllOuts( BNDynP( beta,k) ) = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 + m%AllOuts( BNRe( beta,k) ) = p%BEMT%chord(j,k) * m%BEMT_y%Vrel(j,k) / p%KinVisc / 1.0E6 + m%AllOuts( BNM( beta,k) ) = m%BEMT_y%Vrel(j,k) / p%SpdSound + + m%AllOuts( BNVIndx(beta,k) ) = - m%BEMT_u(indx)%Vx(j,k) * m%BEMT_y%axInduction( j,k) + m%AllOuts( BNVIndy(beta,k) ) = m%BEMT_u(indx)%Vy(j,k) * m%BEMT_y%tanInduction(j,k) + + m%AllOuts( BNAxInd(beta,k) ) = m%BEMT_y%axInduction(j,k) + m%AllOuts( BNTnInd(beta,k) ) = m%BEMT_y%tanInduction(j,k) + + m%AllOuts( BNAlpha(beta,k) ) = Rad2M180to180Deg( m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k) ) + m%AllOuts( BNTheta(beta,k) ) = m%BEMT_u(indx)%theta(j,k)*R2D + m%AllOuts( BNPhi( beta,k) ) = m%BEMT_y%phi(j,k)*R2D + m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D + + !m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cl(j,k) + !m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cd(j,k) + + m%AllOuts( BNCpmin( beta,k) ) = m%BEMT_y%Cpmin(j,k) + m%AllOuts( BNSigCr( beta,k) ) = m%SigmaCavitCrit(j,k) + m%AllOuts( BNSgCav( beta,k) ) = m%SigmaCavit(j,k) + + cp=cos(m%BEMT_y%phi(j,k)) + sp=sin(m%BEMT_y%phi(j,k)) + m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cx(j,k)*cp + m%BEMT_y%Cy(j,k)*sp + m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cx(j,k)*sp - m%BEMT_y%Cy(j,k)*cp + m%AllOuts( BNCm( beta,k) ) = m%BEMT_y%Cm(j,k) + m%AllOuts( BNCx( beta,k) ) = m%BEMT_y%Cx(j,k) + m%AllOuts( BNCy( beta,k) ) = m%BEMT_y%Cy(j,k) + + ct=cos(m%BEMT_u(indx)%theta(j,k)) + st=sin(m%BEMT_u(indx)%theta(j,k)) + m%AllOuts( BNCn( beta,k) ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st + m%AllOuts( BNCt( beta,k) ) =-m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct + + m%AllOuts( BNFl( beta,k) ) = m%X(j,k)*cp - m%Y(j,k)*sp + m%AllOuts( BNFd( beta,k) ) = m%X(j,k)*sp + m%Y(j,k)*cp + m%AllOuts( BNMm( beta,k) ) = m%M(j,k) + m%AllOuts( BNFx( beta,k) ) = m%X(j,k) + m%AllOuts( BNFy( beta,k) ) = -m%Y(j,k) + m%AllOuts( BNFn( beta,k) ) = m%X(j,k)*ct - m%Y(j,k)*st + m%AllOuts( BNFt( beta,k) ) = -m%X(j,k)*st - m%Y(j,k)*ct + + m%AllOuts( BNGam( beta,k) ) = 0.5_ReKi * p%BEMT%chord(j,k) * m%BEMT_y%Vrel(j,k) * m%BEMT_y%Cl(j,k) ! "Gam" [m^2/s] + end do ! nodes + end do ! blades + + ! rotor outputs: + rmax = 0.0_ReKi + do k=1,p%NumBlades + do j=1,p%NumBlNds + rmax = max(rmax, m%BEMT_u(indx)%rLocal(j,k) ) + end do !j=nodes + end do !k=blades + + m%AllOuts( RtSpeed ) = m%BEMT_u(indx)%omega*RPS2RPM + m%AllOuts( RtArea ) = pi*rmax**2 + + tmp = matmul( u%HubMotion%Orientation(:,:,1), m%V_DiskAvg ) + m%AllOuts( RtVAvgxh ) = tmp(1) + m%AllOuts( RtVAvgyh ) = tmp(2) + m%AllOuts( RtVAvgzh ) = tmp(3) + + m%AllOuts( RtSkew ) = m%BEMT_u(indx)%chi0*R2D + + ! integrate force/moments over blades by performing mesh transfer to hub point: + force = 0.0_ReKi + moment = 0.0_ReKi + do k=1,p%NumBlades + call Transfer_Line2_to_Point( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2, u%BladeMotion(k), u%HubMotion ) + force = force + m%HubLoad%force( :,1) + moment = moment + m%HubLoad%moment(:,1) + end do + tmp = matmul( u%HubMotion%Orientation(:,:,1), force ) + m%AllOuts( RtAeroFxh ) = tmp(1) + m%AllOuts( RtAeroFyh ) = tmp(2) + m%AllOuts( RtAeroFzh ) = tmp(3) + + tmp = matmul( u%HubMotion%Orientation(:,:,1), moment ) + m%AllOuts( RtAeroMxh ) = tmp(1) + m%AllOuts( RtAeroMyh ) = tmp(2) + m%AllOuts( RtAeroMzh ) = tmp(3) + + m%AllOuts( RtAeroPwr ) = m%BEMT_u(indx)%omega * m%AllOuts( RtAeroMxh ) + + + if ( EqualRealNos( m%V_dot_x, 0.0_ReKi ) ) then + m%AllOuts( RtTSR ) = 0.0_ReKi + m%AllOuts( RtAeroCp ) = 0.0_ReKi + m%AllOuts( RtAeroCq ) = 0.0_ReKi + m%AllOuts( RtAeroCt ) = 0.0_ReKi + else + denom = 0.5*p%AirDens*m%AllOuts( RtArea )*m%V_dot_x**2 + m%AllOuts( RtTSR ) = m%BEMT_u(indx)%omega * rmax / m%V_dot_x + + m%AllOuts( RtAeroCp ) = m%AllOuts( RtAeroPwr ) / (denom * m%V_dot_x) + m%AllOuts( RtAeroCq ) = m%AllOuts( RtAeroMxh ) / (denom * rmax) + m%AllOuts( RtAeroCt ) = m%AllOuts( RtAeroFxh ) / denom + end if + end subroutine Calc_WriteOutput_BEMT + + !> Similar to Calc_WriteOutput_BEMT. TODO Merge me + !! NOTE: relies on the prior calculation of m%V_dot_x, and m%V_diskAvg (done in DiskAvgValues) + !! m%DisturbedInflow (done in SetInputs) + !! Make sure these are set! + subroutine Calc_WriteOutput_FVW + + real(ReKi) :: rmax, omega + + ! blade outputs + do k=1,p%numBlades + do beta=1,p%NBlOuts + j=p%BlOutNd(beta) + + ! --- Setting AD outputs + tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%InflowOnBlade(:,j,k) ) + m%AllOuts( BNVUndx(beta,k) ) = tmp(1) + m%AllOuts( BNVUndy(beta,k) ) = tmp(2) + m%AllOuts( BNVUndz(beta,k) ) = tmp(3) + + tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), m%DisturbedInflow(:,j,k) ) + m%AllOuts( BNVDisx(beta,k) ) = tmp(1) + m%AllOuts( BNVDisy(beta,k) ) = tmp(2) + m%AllOuts( BNVDisz(beta,k) ) = tmp(3) + + tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%BladeMotion(k)%TranslationVel(:,j) ) + m%AllOuts( BNSTVx( beta,k) ) = tmp(1) + m%AllOuts( BNSTVy( beta,k) ) = tmp(2) + m%AllOuts( BNSTVz( beta,k) ) = tmp(3) + + m%AllOuts( BNVrel( beta,k) ) = m%FVW%BN_Vrel(j,k) + m%AllOuts( BNDynP( beta,k) ) = 0.5 * p%airDens * m%FVW%BN_Vrel(j,k)**2 + m%AllOuts( BNRe( beta,k) ) = m%FVW%BN_Re(j,k) + m%AllOuts( BNM( beta,k) ) = m%FVW%BN_Vrel(j,k) / p%SpdSound + + m%AllOuts( BNVIndx(beta,k) ) = -m%FVW%BN_UrelWind_s(1,j,k) * m%FVW%BN_AxInd(j,k) + m%AllOuts( BNVIndy(beta,k) ) = m%FVW%BN_UrelWind_s(2,j,k) * m%FVW%BN_TanInd(j,k) + + m%AllOuts( BNAxInd(beta,k) ) = m%FVW%BN_AxInd(j,k) + m%AllOuts( BNTnInd(beta,k) ) = m%FVW%BN_TanInd(j,k) + + m%AllOuts( BNAlpha(beta,k) ) = m%FVW%BN_alpha(j,k)*R2D + m%AllOuts( BNTheta(beta,k) ) = m%FVW%PitchAndTwist(j,k)*R2D + m%AllOuts( BNPhi( beta,k) ) = m%FVW%BN_phi(j,k)*R2D +! m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D ! TODO + +! m%AllOuts( BNCpmin( beta,k) ) = m%BEMT_y%Cpmin(j,k) ! TODO + m%AllOuts( BNSigCr( beta,k) ) = m%SigmaCavitCrit(j,k) + m%AllOuts( BNSgCav( beta,k) ) = m%SigmaCavit(j,k) + + m%AllOuts( BNCl( beta,k) ) = m%FVW%BN_Cl(j,k) + m%AllOuts( BNCd( beta,k) ) = m%FVW%BN_Cd(j,k) + m%AllOuts( BNCm( beta,k) ) = m%FVW%BN_Cm(j,k) + m%AllOuts( BNCx( beta,k) ) = m%FVW%BN_Cx(j,k) + m%AllOuts( BNCy( beta,k) ) = m%FVW%BN_Cy(j,k) + + ct=cos(m%FVW%PitchAndTwist(j,k)) ! cos(theta) + st=sin(m%FVW%PitchAndTwist(j,k)) ! sin(theta) + m%AllOuts( BNCn( beta,k) ) = m%FVW%BN_Cx(j,k)*ct + m%FVW%BN_Cy(j,k)*st + m%AllOuts( BNCt( beta,k) ) =-m%FVW%BN_Cx(j,k)*st + m%FVW%BN_Cy(j,k)*ct + + cp=cos(m%FVW%BN_phi(j,k)) + sp=sin(m%FVW%BN_phi(j,k)) + m%AllOuts( BNFl( beta,k) ) = m%X(j,k)*cp - m%Y(j,k)*sp + m%AllOuts( BNFd( beta,k) ) = m%X(j,k)*sp + m%Y(j,k)*cp + m%AllOuts( BNMm( beta,k) ) = m%M(j,k) + m%AllOuts( BNFx( beta,k) ) = m%X(j,k) + m%AllOuts( BNFy( beta,k) ) = -m%Y(j,k) + m%AllOuts( BNFn( beta,k) ) = m%X(j,k)*ct - m%Y(j,k)*st + m%AllOuts( BNFt( beta,k) ) = -m%X(j,k)*st - m%Y(j,k)*ct + + m%AllOuts( BNGam( beta,k) ) = 0.5_ReKi * p%FVW%Chord(j,k) * m%FVW%BN_Vrel(j,k) * m%FVW%BN_Cl(j,k) ! "Gam" [m^2/s] + end do ! nodes + end do ! blades + + ! Compute max radius and rotor speed + rmax = Calc_MaxRadius(p, u) + omega = Calc_Omega(u) + + m%AllOuts( RtSpeed ) = omega*RPS2RPM + m%AllOuts( RtArea ) = pi*rmax**2 + + tmp = matmul( u%HubMotion%Orientation(:,:,1), m%V_DiskAvg ) + m%AllOuts( RtVAvgxh ) = tmp(1) + m%AllOuts( RtVAvgyh ) = tmp(2) + m%AllOuts( RtVAvgzh ) = tmp(3) + + m%AllOuts( RtSkew ) = Calc_Chi0(m%V_diskAvg, m%V_dot_x) * R2D + + ! integrate force/moments over blades by performing mesh transfer to hub point: + force = 0.0_ReKi + moment = 0.0_ReKi + do k=1,p%NumBlades + call Transfer_Line2_to_Point( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2, u%BladeMotion(k), u%HubMotion ) + force = force + m%HubLoad%force( :,1) + moment = moment + m%HubLoad%moment(:,1) + end do + tmp = matmul( u%HubMotion%Orientation(:,:,1), force ) + m%AllOuts( RtAeroFxh ) = tmp(1) + m%AllOuts( RtAeroFyh ) = tmp(2) + m%AllOuts( RtAeroFzh ) = tmp(3) + + tmp = matmul( u%HubMotion%Orientation(:,:,1), moment ) + m%AllOuts( RtAeroMxh ) = tmp(1) + m%AllOuts( RtAeroMyh ) = tmp(2) + m%AllOuts( RtAeroMzh ) = tmp(3) + + m%AllOuts( RtAeroPwr ) = omega * m%AllOuts( RtAeroMxh ) + + if ( EqualRealNos( m%V_dot_x, 0.0_ReKi ) ) then + m%AllOuts( RtTSR ) = 0.0_ReKi + m%AllOuts( RtAeroCp ) = 0.0_ReKi + m%AllOuts( RtAeroCq ) = 0.0_ReKi + m%AllOuts( RtAeroCt ) = 0.0_ReKi + else + denom = 0.5*p%AirDens*m%AllOuts( RtArea )*m%V_dot_x**2 + m%AllOuts( RtTSR ) = omega * rmax / m%V_dot_x + m%AllOuts( RtAeroCp ) = m%AllOuts( RtAeroPwr ) / (denom * m%V_dot_x) + m%AllOuts( RtAeroCq ) = m%AllOuts( RtAeroMxh ) / (denom * rmax) + m%AllOuts( RtAeroCt ) = m%AllOuts( RtAeroFxh ) / denom + end if + + end subroutine Calc_WriteOutput_FVW END SUBROUTINE Calc_WriteOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1884,6 +2008,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE integer(IntKi) :: ErrStat2, IOS ! Temporary Error status logical :: Echo ! Determines if an echo file should be written character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts ! 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") @@ -1901,7 +2026,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Get an available unit number for the file. CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) @@ -1990,8 +2119,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - ! WakeMod - Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%WakeMod, "WakeMod", "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT} (-)", ErrStat2, ErrMsg2, UnEc) + ! WakeMod - Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} (-): + CALL ReadVar( UnIn, InputFile, InputFileData%WakeMod, "WakeMod", "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! AFAeroMod - Type of airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} (-): @@ -2023,6 +2152,14 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE ! CALL ReadVar( UnIn, InputFile, InputFileData%AddedMass, "AddedMass", "Include added mass effects? (flag)", ErrStat2, ErrMsg2, UnEc) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! CompAA - Compute AeroAcoustics? (flag): + CALL ReadVar( UnIn, InputFile, InputFileData%CompAA, "CompAA", "Compute AeroAcoustics? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! AA_Inputfile + CALL ReadVar ( UnIn, InputFile, InputFileData%AA_InputFile, "AA_Inputfile", "AeroAcoustics Input filename", ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PathIsRelative( InputFileData%AA_InputFile ) ) InputFileData%AA_InputFile = TRIM(PriPath)//TRIM(InputFileData%AA_InputFile) ! Return on error at end of section IF ( ErrStat >= AbortErrLev ) THEN @@ -2071,11 +2208,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadCom( UnIn, InputFile, 'Section Header: Blade-Element/Momentum Theory Options', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! SkewMod - Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} (-) [unused when WakeMod=0]: - CALL ReadVar( UnIn, InputFile, InputFileData%SkewMod, "SkewMod", "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} (-) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + ! SkewMod - Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} (-) [unused when WakeMod={0|3}]: + CALL ReadVar( UnIn, InputFile, InputFileData%SkewMod, "SkewMod", "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} (-) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! SkewModFactor - Constant used in Pitt/Peters skewed wake model {or default is 15/32*pi} (-) [used only when WakeMod/=0 and SkewMod=2]: + ! SkewModFactor - Constant used in Pitt/Peters skewed wake model {or default is 15/32*pi} (-) [used only when WakeMod/={0|3} and SkewMod=2]: Line = "" CALL ReadVar( UnIn, InputFile, Line, "SkewModFactor", "Constant used in Pitt/Peters skewed wake model {or default} (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2090,29 +2227,29 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE END IF - ! TipLoss - Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0]: - CALL ReadVar( UnIn, InputFile, InputFileData%TipLoss, "TipLoss", "Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + ! TipLoss - Use the Prandtl tip-loss model? (flag) [unused when WakeMod={0|3}]: + CALL ReadVar( UnIn, InputFile, InputFileData%TipLoss, "TipLoss", "Use the Prandtl tip-loss model? (flag) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! HubLoss - Use the Prandtl hub-loss model? (flag) [unused when WakeMod=0]: - CALL ReadVar( UnIn, InputFile, InputFileData%HubLoss, "HubLoss", "Use the Prandtl hub-loss model? (flag) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + ! HubLoss - Use the Prandtl hub-loss model? (flag) [unused when WakeMod={0|3}]: + CALL ReadVar( UnIn, InputFile, InputFileData%HubLoss, "HubLoss", "Use the Prandtl hub-loss model? (flag) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! TanInd - Include tangential induction in BEMT calculations? (flag) [unused when WakeMod=0]: - CALL ReadVar( UnIn, InputFile, InputFileData%TanInd, "TanInd", "Include tangential induction in BEMT calculations? (flag) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + ! TanInd - Include tangential induction in BEMT calculations? (flag) [unused when WakeMod={0|3}]: + CALL ReadVar( UnIn, InputFile, InputFileData%TanInd, "TanInd", "Include tangential induction in BEMT calculations? (flag) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! AIDrag - Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod=0]: - CALL ReadVar( UnIn, InputFile, InputFileData%AIDrag, "AIDrag", "Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + ! AIDrag - Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod={0|3}]: + CALL ReadVar( UnIn, InputFile, InputFileData%AIDrag, "AIDrag", "Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! TIDrag - Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod=0 or TanInd=FALSE]: - CALL ReadVar( UnIn, InputFile, InputFileData%TIDrag, "TIDrag", "Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod=0 or TanInd=FALSE]", ErrStat2, ErrMsg2, UnEc) + ! TIDrag - Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod={0|3} or TanInd=FALSE]: + CALL ReadVar( UnIn, InputFile, InputFileData%TIDrag, "TIDrag", "Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod={0|3} or TanInd=FALSE]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IndToler - Convergence tolerance for BEM induction factors (or "default"] (-) [unused when WakeMod=0]: + ! IndToler - Convergence tolerance for BEM induction factors (or "default"] (-) [unused when WakeMod={0|3}]: Line = "" - CALL ReadVar( UnIn, InputFile, Line, "IndToler", "Convergence tolerance for BEM induction factors (-) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, Line, "IndToler", "Convergence tolerance for BEM induction factors (-) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL Conv2UC( Line ) @@ -2129,8 +2266,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE END IF - ! MaxIter - Maximum number of iteration steps [unused when WakeMod=0] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%MaxIter, "MaxIter", "Maximum number of iteration steps (-) [unused when WakeMod=0]", ErrStat2, ErrMsg2, UnEc) + ! MaxIter - Maximum number of iteration steps [unused when WakeMod={0|3}] (-): + CALL ReadVar( UnIn, InputFile, InputFileData%MaxIter, "MaxIter", "Maximum number of iteration steps (-) [unused when WakeMod={0|3}]", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Return on error at end of section @@ -2153,12 +2290,21 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !----------- FREE VORTEX WAKE (FVW) THEORY OPTIONS ------------------------------ + CALL ReadCom( UnIn, InputFile, 'Section Header: Free Vortex Wake (FVW) Theory Options', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar ( UnIn, InputFile, InputFileData%FVWFileName, 'FVWFile', 'FVW input file name', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PathIsRelative( InputFileData%FVWFileName ) ) InputFileData%FVWFileName = TRIM(PriPath)//TRIM(InputFileData%FVWFileName) + + !----------- BEDDOES-LEISHMAN UNSTEADY AIRFOIL AERODYNAMICS OPTIONS ------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Beddoes-Leishman Unsteady Airfoil Aerodynamics Options', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) + ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): + CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag): @@ -2359,6 +2505,80 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Return on error at end of section + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + !---------------------- END OF FILE ----------------------------------------- + + + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. + ErrMsg_NoAllBldNdOuts='Nodal output section of AeroDyn input file not found or improperly formatted.' + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: In a future release, allow this to be an array of N blade numbers (change BldNd_BladesOut to an array if we do that). + ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Which blades to output for: will add this at some point + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + !---------------------- END OF FILE ----------------------------------------- CALL Cleanup( ) @@ -2552,6 +2772,8 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) Msg = 'Blade-Element/Momentum Theory' case (WakeMod_DBEMT) Msg = 'Dynamic Blade-Element/Momentum Theory' + case (WakeMod_FVW) + Msg = 'Free Vortex Wake Theory' case (WakeMod_None) Msg = 'steady' case default @@ -2696,7 +2918,7 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) case (2) Msg = "Gonzalez's variant (changes in Cn, Cc, and Cm)" case (3) - Msg = 'Minemma/Pierce variant (changes in Cc and Cm)' + Msg = 'Minnema/Pierce variant (changes in Cc and Cm)' !case (4) ! Msg = 'DYSTOOL' case default @@ -2741,9 +2963,6 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) end if -#ifndef DBG_OUTS -! p%OutParam isn't allocated when DBG_OUTS is defined - OutPFmt = '( 15x, I4, 2X, A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' WRITE (UnSu,'(15x,A)') 'Requested Output Channels:' WRITE (UnSu,'(15x,A)') 'Col Parameter Units' @@ -2752,7 +2971,15 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) DO I = 0,p%NumOuts WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO -#endif + + 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)') '---- -------------- -----' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO CLOSE(UnSu) @@ -2772,7 +2999,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 16-Feb-2017 15:50:51. +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 05-May-2020 06:44:07. SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -2797,503 +3024,518 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1184) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1211) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "B1AZIMUTH","B1N1ALPHA","B1N1AXIND","B1N1CD ","B1N1CL ","B1N1CLRNC","B1N1CM ", & "B1N1CN ","B1N1CPMIN","B1N1CT ","B1N1CURVE","B1N1CX ","B1N1CY ","B1N1DYNP ", & - "B1N1FD ","B1N1FL ","B1N1FN ","B1N1FT ","B1N1FX ","B1N1FY ","B1N1M ", & - "B1N1MM ","B1N1PHI ","B1N1RE ","B1N1SGCAV","B1N1SIGCR","B1N1STVX ","B1N1STVY ", & - "B1N1STVZ ","B1N1THETA","B1N1TNIND","B1N1VDISX","B1N1VDISY","B1N1VDISZ","B1N1VINDX", & - "B1N1VINDY","B1N1VREL ","B1N1VUNDX","B1N1VUNDY","B1N1VUNDZ","B1N2ALPHA","B1N2AXIND", & - "B1N2CD ","B1N2CL ","B1N2CLRNC","B1N2CM ","B1N2CN ","B1N2CPMIN","B1N2CT ", & - "B1N2CURVE","B1N2CX ","B1N2CY ","B1N2DYNP ","B1N2FD ","B1N2FL ","B1N2FN ", & - "B1N2FT ","B1N2FX ","B1N2FY ","B1N2M ","B1N2MM ","B1N2PHI ","B1N2RE ", & - "B1N2SGCAV","B1N2SIGCR","B1N2STVX ","B1N2STVY ","B1N2STVZ ","B1N2THETA","B1N2TNIND", & - "B1N2VDISX","B1N2VDISY","B1N2VDISZ","B1N2VINDX","B1N2VINDY","B1N2VREL ","B1N2VUNDX", & - "B1N2VUNDY","B1N2VUNDZ","B1N3ALPHA","B1N3AXIND","B1N3CD ","B1N3CL ","B1N3CLRNC", & - "B1N3CM ","B1N3CN ","B1N3CPMIN","B1N3CT ","B1N3CURVE","B1N3CX ","B1N3CY ", & - "B1N3DYNP ","B1N3FD ","B1N3FL ","B1N3FN ","B1N3FT ","B1N3FX ","B1N3FY ", & - "B1N3M ","B1N3MM ","B1N3PHI ","B1N3RE ","B1N3SGCAV","B1N3SIGCR","B1N3STVX ", & - "B1N3STVY ","B1N3STVZ ","B1N3THETA","B1N3TNIND","B1N3VDISX","B1N3VDISY","B1N3VDISZ", & - "B1N3VINDX","B1N3VINDY","B1N3VREL ","B1N3VUNDX","B1N3VUNDY","B1N3VUNDZ","B1N4ALPHA", & - "B1N4AXIND","B1N4CD ","B1N4CL ","B1N4CLRNC","B1N4CM ","B1N4CN ","B1N4CPMIN", & - "B1N4CT ","B1N4CURVE","B1N4CX ","B1N4CY ","B1N4DYNP ","B1N4FD ","B1N4FL ", & - "B1N4FN ","B1N4FT ","B1N4FX ","B1N4FY ","B1N4M ","B1N4MM ","B1N4PHI ", & - "B1N4RE ","B1N4SGCAV","B1N4SIGCR","B1N4STVX ","B1N4STVY ","B1N4STVZ ","B1N4THETA", & - "B1N4TNIND","B1N4VDISX","B1N4VDISY","B1N4VDISZ","B1N4VINDX","B1N4VINDY","B1N4VREL ", & - "B1N4VUNDX","B1N4VUNDY","B1N4VUNDZ","B1N5ALPHA","B1N5AXIND","B1N5CD ","B1N5CL ", & - "B1N5CLRNC","B1N5CM ","B1N5CN ","B1N5CPMIN","B1N5CT ","B1N5CURVE","B1N5CX ", & - "B1N5CY ","B1N5DYNP ","B1N5FD ","B1N5FL ","B1N5FN ","B1N5FT ","B1N5FX ", & - "B1N5FY ","B1N5M ","B1N5MM ","B1N5PHI ","B1N5RE ","B1N5SGCAV","B1N5SIGCR", & - "B1N5STVX ","B1N5STVY ","B1N5STVZ ","B1N5THETA","B1N5TNIND","B1N5VDISX","B1N5VDISY", & - "B1N5VDISZ","B1N5VINDX","B1N5VINDY","B1N5VREL ","B1N5VUNDX","B1N5VUNDY","B1N5VUNDZ", & - "B1N6ALPHA","B1N6AXIND","B1N6CD ","B1N6CL ","B1N6CLRNC","B1N6CM ","B1N6CN ", & - "B1N6CPMIN","B1N6CT ","B1N6CURVE","B1N6CX ","B1N6CY ","B1N6DYNP ","B1N6FD ", & - "B1N6FL ","B1N6FN ","B1N6FT ","B1N6FX ","B1N6FY ","B1N6M ","B1N6MM ", & - "B1N6PHI ","B1N6RE ","B1N6SGCAV","B1N6SIGCR","B1N6STVX ","B1N6STVY ","B1N6STVZ ", & - "B1N6THETA","B1N6TNIND","B1N6VDISX","B1N6VDISY","B1N6VDISZ","B1N6VINDX","B1N6VINDY", & - "B1N6VREL ","B1N6VUNDX","B1N6VUNDY","B1N6VUNDZ","B1N7ALPHA","B1N7AXIND","B1N7CD ", & - "B1N7CL ","B1N7CLRNC","B1N7CM ","B1N7CN ","B1N7CPMIN","B1N7CT ","B1N7CURVE", & - "B1N7CX ","B1N7CY ","B1N7DYNP ","B1N7FD ","B1N7FL ","B1N7FN ","B1N7FT ", & - "B1N7FX ","B1N7FY ","B1N7M ","B1N7MM ","B1N7PHI ","B1N7RE ","B1N7SGCAV", & + "B1N1FD ","B1N1FL ","B1N1FN ","B1N1FT ","B1N1FX ","B1N1FY ","B1N1GAM ", & + "B1N1M ","B1N1MM ","B1N1PHI ","B1N1RE ","B1N1SGCAV","B1N1SIGCR","B1N1STVX ", & + "B1N1STVY ","B1N1STVZ ","B1N1THETA","B1N1TNIND","B1N1VDISX","B1N1VDISY","B1N1VDISZ", & + "B1N1VINDX","B1N1VINDY","B1N1VREL ","B1N1VUNDX","B1N1VUNDY","B1N1VUNDZ","B1N2ALPHA", & + "B1N2AXIND","B1N2CD ","B1N2CL ","B1N2CLRNC","B1N2CM ","B1N2CN ","B1N2CPMIN", & + "B1N2CT ","B1N2CURVE","B1N2CX ","B1N2CY ","B1N2DYNP ","B1N2FD ","B1N2FL ", & + "B1N2FN ","B1N2FT ","B1N2FX ","B1N2FY ","B1N2GAM ","B1N2M ","B1N2MM ", & + "B1N2PHI ","B1N2RE ","B1N2SGCAV","B1N2SIGCR","B1N2STVX ","B1N2STVY ","B1N2STVZ ", & + "B1N2THETA","B1N2TNIND","B1N2VDISX","B1N2VDISY","B1N2VDISZ","B1N2VINDX","B1N2VINDY", & + "B1N2VREL ","B1N2VUNDX","B1N2VUNDY","B1N2VUNDZ","B1N3ALPHA","B1N3AXIND","B1N3CD ", & + "B1N3CL ","B1N3CLRNC","B1N3CM ","B1N3CN ","B1N3CPMIN","B1N3CT ","B1N3CURVE", & + "B1N3CX ","B1N3CY ","B1N3DYNP ","B1N3FD ","B1N3FL ","B1N3FN ","B1N3FT ", & + "B1N3FX ","B1N3FY ","B1N3GAM ","B1N3M ","B1N3MM ","B1N3PHI ","B1N3RE ", & + "B1N3SGCAV","B1N3SIGCR","B1N3STVX ","B1N3STVY ","B1N3STVZ ","B1N3THETA","B1N3TNIND", & + "B1N3VDISX","B1N3VDISY","B1N3VDISZ","B1N3VINDX","B1N3VINDY","B1N3VREL ","B1N3VUNDX", & + "B1N3VUNDY","B1N3VUNDZ","B1N4ALPHA","B1N4AXIND","B1N4CD ","B1N4CL ","B1N4CLRNC", & + "B1N4CM ","B1N4CN ","B1N4CPMIN","B1N4CT ","B1N4CURVE","B1N4CX ","B1N4CY ", & + "B1N4DYNP ","B1N4FD ","B1N4FL ","B1N4FN ","B1N4FT ","B1N4FX ","B1N4FY ", & + "B1N4GAM ","B1N4M ","B1N4MM ","B1N4PHI ","B1N4RE ","B1N4SGCAV","B1N4SIGCR", & + "B1N4STVX ","B1N4STVY ","B1N4STVZ ","B1N4THETA","B1N4TNIND","B1N4VDISX","B1N4VDISY", & + "B1N4VDISZ","B1N4VINDX","B1N4VINDY","B1N4VREL ","B1N4VUNDX","B1N4VUNDY","B1N4VUNDZ", & + "B1N5ALPHA","B1N5AXIND","B1N5CD ","B1N5CL ","B1N5CLRNC","B1N5CM ","B1N5CN ", & + "B1N5CPMIN","B1N5CT ","B1N5CURVE","B1N5CX ","B1N5CY ","B1N5DYNP ","B1N5FD ", & + "B1N5FL ","B1N5FN ","B1N5FT ","B1N5FX ","B1N5FY ","B1N5GAM ","B1N5M ", & + "B1N5MM ","B1N5PHI ","B1N5RE ","B1N5SGCAV","B1N5SIGCR","B1N5STVX ","B1N5STVY ", & + "B1N5STVZ ","B1N5THETA","B1N5TNIND","B1N5VDISX","B1N5VDISY","B1N5VDISZ","B1N5VINDX", & + "B1N5VINDY","B1N5VREL ","B1N5VUNDX","B1N5VUNDY","B1N5VUNDZ","B1N6ALPHA","B1N6AXIND", & + "B1N6CD ","B1N6CL ","B1N6CLRNC","B1N6CM ","B1N6CN ","B1N6CPMIN","B1N6CT ", & + "B1N6CURVE","B1N6CX ","B1N6CY ","B1N6DYNP ","B1N6FD ","B1N6FL ","B1N6FN ", & + "B1N6FT ","B1N6FX ","B1N6FY ","B1N6GAM ","B1N6M ","B1N6MM ","B1N6PHI ", & + "B1N6RE ","B1N6SGCAV","B1N6SIGCR","B1N6STVX ","B1N6STVY ","B1N6STVZ ","B1N6THETA", & + "B1N6TNIND","B1N6VDISX","B1N6VDISY","B1N6VDISZ","B1N6VINDX","B1N6VINDY","B1N6VREL ", & + "B1N6VUNDX","B1N6VUNDY","B1N6VUNDZ","B1N7ALPHA","B1N7AXIND","B1N7CD ","B1N7CL ", & + "B1N7CLRNC","B1N7CM ","B1N7CN ","B1N7CPMIN","B1N7CT ","B1N7CURVE","B1N7CX ", & + "B1N7CY ","B1N7DYNP ","B1N7FD ","B1N7FL ","B1N7FN ","B1N7FT ","B1N7FX ", & + "B1N7FY ","B1N7GAM ","B1N7M ","B1N7MM ","B1N7PHI ","B1N7RE ","B1N7SGCAV", & "B1N7SIGCR","B1N7STVX ","B1N7STVY ","B1N7STVZ ","B1N7THETA","B1N7TNIND","B1N7VDISX", & "B1N7VDISY","B1N7VDISZ","B1N7VINDX","B1N7VINDY","B1N7VREL ","B1N7VUNDX","B1N7VUNDY", & "B1N7VUNDZ","B1N8ALPHA","B1N8AXIND","B1N8CD ","B1N8CL ","B1N8CLRNC","B1N8CM ", & "B1N8CN ","B1N8CPMIN","B1N8CT ","B1N8CURVE","B1N8CX ","B1N8CY ","B1N8DYNP ", & - "B1N8FD ","B1N8FL ","B1N8FN ","B1N8FT ","B1N8FX ","B1N8FY ","B1N8M ", & - "B1N8MM ","B1N8PHI ","B1N8RE ","B1N8SGCAV","B1N8SIGCR","B1N8STVX ","B1N8STVY ", & - "B1N8STVZ ","B1N8THETA","B1N8TNIND","B1N8VDISX","B1N8VDISY","B1N8VDISZ","B1N8VINDX", & - "B1N8VINDY","B1N8VREL ","B1N8VUNDX","B1N8VUNDY","B1N8VUNDZ","B1N9ALPHA","B1N9AXIND", & - "B1N9CD ","B1N9CL ","B1N9CLRNC","B1N9CM ","B1N9CN ","B1N9CPMIN","B1N9CT ", & - "B1N9CURVE","B1N9CX ","B1N9CY ","B1N9DYNP ","B1N9FD ","B1N9FL ","B1N9FN ", & - "B1N9FT ","B1N9FX ","B1N9FY ","B1N9M ","B1N9MM ","B1N9PHI ","B1N9RE ", & - "B1N9SGCAV","B1N9SIGCR","B1N9STVX ","B1N9STVY ","B1N9STVZ ","B1N9THETA","B1N9TNIND", & - "B1N9VDISX","B1N9VDISY","B1N9VDISZ","B1N9VINDX","B1N9VINDY","B1N9VREL ","B1N9VUNDX", & - "B1N9VUNDY","B1N9VUNDZ","B1PITCH ","B2AZIMUTH","B2N1ALPHA","B2N1AXIND","B2N1CD ", & - "B2N1CL ","B2N1CLRNC","B2N1CM ","B2N1CN ","B2N1CPMIN","B2N1CT ","B2N1CURVE", & - "B2N1CX ","B2N1CY ","B2N1DYNP ","B2N1FD ","B2N1FL ","B2N1FN ","B2N1FT ", & - "B2N1FX ","B2N1FY ","B2N1M ","B2N1MM ","B2N1PHI ","B2N1RE ","B2N1SGCAV", & - "B2N1SIGCR","B2N1STVX ","B2N1STVY ","B2N1STVZ ","B2N1THETA","B2N1TNIND","B2N1VDISX", & - "B2N1VDISY","B2N1VDISZ","B2N1VINDX","B2N1VINDY","B2N1VREL ","B2N1VUNDX","B2N1VUNDY", & - "B2N1VUNDZ","B2N2ALPHA","B2N2AXIND","B2N2CD ","B2N2CL ","B2N2CLRNC","B2N2CM ", & - "B2N2CN ","B2N2CPMIN","B2N2CT ","B2N2CURVE","B2N2CX ","B2N2CY ","B2N2DYNP ", & - "B2N2FD ","B2N2FL ","B2N2FN ","B2N2FT ","B2N2FX ","B2N2FY ","B2N2M ", & - "B2N2MM ","B2N2PHI ","B2N2RE ","B2N2SGCAV","B2N2SIGCR","B2N2STVX ","B2N2STVY ", & - "B2N2STVZ ","B2N2THETA","B2N2TNIND","B2N2VDISX","B2N2VDISY","B2N2VDISZ","B2N2VINDX", & - "B2N2VINDY","B2N2VREL ","B2N2VUNDX","B2N2VUNDY","B2N2VUNDZ","B2N3ALPHA","B2N3AXIND", & - "B2N3CD ","B2N3CL ","B2N3CLRNC","B2N3CM ","B2N3CN ","B2N3CPMIN","B2N3CT ", & - "B2N3CURVE","B2N3CX ","B2N3CY ","B2N3DYNP ","B2N3FD ","B2N3FL ","B2N3FN ", & - "B2N3FT ","B2N3FX ","B2N3FY ","B2N3M ","B2N3MM ","B2N3PHI ","B2N3RE ", & - "B2N3SGCAV","B2N3SIGCR","B2N3STVX ","B2N3STVY ","B2N3STVZ ","B2N3THETA","B2N3TNIND", & - "B2N3VDISX","B2N3VDISY","B2N3VDISZ","B2N3VINDX","B2N3VINDY","B2N3VREL ","B2N3VUNDX", & - "B2N3VUNDY","B2N3VUNDZ","B2N4ALPHA","B2N4AXIND","B2N4CD ","B2N4CL ","B2N4CLRNC", & - "B2N4CM ","B2N4CN ","B2N4CPMIN","B2N4CT ","B2N4CURVE","B2N4CX ","B2N4CY ", & - "B2N4DYNP ","B2N4FD ","B2N4FL ","B2N4FN ","B2N4FT ","B2N4FX ","B2N4FY ", & - "B2N4M ","B2N4MM ","B2N4PHI ","B2N4RE ","B2N4SGCAV","B2N4SIGCR","B2N4STVX ", & - "B2N4STVY ","B2N4STVZ ","B2N4THETA","B2N4TNIND","B2N4VDISX","B2N4VDISY","B2N4VDISZ", & - "B2N4VINDX","B2N4VINDY","B2N4VREL ","B2N4VUNDX","B2N4VUNDY","B2N4VUNDZ","B2N5ALPHA", & - "B2N5AXIND","B2N5CD ","B2N5CL ","B2N5CLRNC","B2N5CM ","B2N5CN ","B2N5CPMIN", & - "B2N5CT ","B2N5CURVE","B2N5CX ","B2N5CY ","B2N5DYNP ","B2N5FD ","B2N5FL ", & - "B2N5FN ","B2N5FT ","B2N5FX ","B2N5FY ","B2N5M ","B2N5MM ","B2N5PHI ", & + "B1N8FD ","B1N8FL ","B1N8FN ","B1N8FT ","B1N8FX ","B1N8FY ","B1N8GAM ", & + "B1N8M ","B1N8MM ","B1N8PHI ","B1N8RE ","B1N8SGCAV","B1N8SIGCR","B1N8STVX ", & + "B1N8STVY ","B1N8STVZ ","B1N8THETA","B1N8TNIND","B1N8VDISX","B1N8VDISY","B1N8VDISZ", & + "B1N8VINDX","B1N8VINDY","B1N8VREL ","B1N8VUNDX","B1N8VUNDY","B1N8VUNDZ","B1N9ALPHA", & + "B1N9AXIND","B1N9CD ","B1N9CL ","B1N9CLRNC","B1N9CM ","B1N9CN ","B1N9CPMIN", & + "B1N9CT ","B1N9CURVE","B1N9CX ","B1N9CY ","B1N9DYNP ","B1N9FD ","B1N9FL ", & + "B1N9FN ","B1N9FT ","B1N9FX ","B1N9FY ","B1N9GAM ","B1N9M ","B1N9MM ", & + "B1N9PHI ","B1N9RE ","B1N9SGCAV","B1N9SIGCR","B1N9STVX ","B1N9STVY ","B1N9STVZ ", & + "B1N9THETA","B1N9TNIND","B1N9VDISX","B1N9VDISY","B1N9VDISZ","B1N9VINDX","B1N9VINDY", & + "B1N9VREL ","B1N9VUNDX","B1N9VUNDY","B1N9VUNDZ","B1PITCH ","B2AZIMUTH","B2N1ALPHA", & + "B2N1AXIND","B2N1CD ","B2N1CL ","B2N1CLRNC","B2N1CM ","B2N1CN ","B2N1CPMIN", & + "B2N1CT ","B2N1CURVE","B2N1CX ","B2N1CY ","B2N1DYNP ","B2N1FD ","B2N1FL ", & + "B2N1FN ","B2N1FT ","B2N1FX ","B2N1FY ","B2N1GAM ","B2N1M ","B2N1MM ", & + "B2N1PHI ","B2N1RE ","B2N1SGCAV","B2N1SIGCR","B2N1STVX ","B2N1STVY ","B2N1STVZ ", & + "B2N1THETA","B2N1TNIND","B2N1VDISX","B2N1VDISY","B2N1VDISZ","B2N1VINDX","B2N1VINDY", & + "B2N1VREL ","B2N1VUNDX","B2N1VUNDY","B2N1VUNDZ","B2N2ALPHA","B2N2AXIND","B2N2CD ", & + "B2N2CL ","B2N2CLRNC","B2N2CM ","B2N2CN ","B2N2CPMIN","B2N2CT ","B2N2CURVE", & + "B2N2CX ","B2N2CY ","B2N2DYNP ","B2N2FD ","B2N2FL ","B2N2FN ","B2N2FT ", & + "B2N2FX ","B2N2FY ","B2N2GAM ","B2N2M ","B2N2MM ","B2N2PHI ","B2N2RE ", & + "B2N2SGCAV","B2N2SIGCR","B2N2STVX ","B2N2STVY ","B2N2STVZ ","B2N2THETA","B2N2TNIND", & + "B2N2VDISX","B2N2VDISY","B2N2VDISZ","B2N2VINDX","B2N2VINDY","B2N2VREL ","B2N2VUNDX", & + "B2N2VUNDY","B2N2VUNDZ","B2N3ALPHA","B2N3AXIND","B2N3CD ","B2N3CL ","B2N3CLRNC", & + "B2N3CM ","B2N3CN ","B2N3CPMIN","B2N3CT ","B2N3CURVE","B2N3CX ","B2N3CY ", & + "B2N3DYNP ","B2N3FD ","B2N3FL ","B2N3FN ","B2N3FT ","B2N3FX ","B2N3FY ", & + "B2N3GAM ","B2N3M ","B2N3MM ","B2N3PHI ","B2N3RE ","B2N3SGCAV","B2N3SIGCR", & + "B2N3STVX ","B2N3STVY ","B2N3STVZ ","B2N3THETA","B2N3TNIND","B2N3VDISX","B2N3VDISY", & + "B2N3VDISZ","B2N3VINDX","B2N3VINDY","B2N3VREL ","B2N3VUNDX","B2N3VUNDY","B2N3VUNDZ", & + "B2N4ALPHA","B2N4AXIND","B2N4CD ","B2N4CL ","B2N4CLRNC","B2N4CM ","B2N4CN ", & + "B2N4CPMIN","B2N4CT ","B2N4CURVE","B2N4CX ","B2N4CY ","B2N4DYNP ","B2N4FD ", & + "B2N4FL ","B2N4FN ","B2N4FT ","B2N4FX ","B2N4FY ","B2N4GAM ","B2N4M ", & + "B2N4MM ","B2N4PHI ","B2N4RE ","B2N4SGCAV","B2N4SIGCR","B2N4STVX ","B2N4STVY ", & + "B2N4STVZ ","B2N4THETA","B2N4TNIND","B2N4VDISX","B2N4VDISY","B2N4VDISZ","B2N4VINDX", & + "B2N4VINDY","B2N4VREL ","B2N4VUNDX","B2N4VUNDY","B2N4VUNDZ","B2N5ALPHA","B2N5AXIND", & + "B2N5CD ","B2N5CL ","B2N5CLRNC","B2N5CM ","B2N5CN ","B2N5CPMIN","B2N5CT ", & + "B2N5CURVE","B2N5CX ","B2N5CY ","B2N5DYNP ","B2N5FD ","B2N5FL ","B2N5FN ", & + "B2N5FT ","B2N5FX ","B2N5FY ","B2N5GAM ","B2N5M ","B2N5MM ","B2N5PHI ", & "B2N5RE ","B2N5SGCAV","B2N5SIGCR","B2N5STVX ","B2N5STVY ","B2N5STVZ ","B2N5THETA", & "B2N5TNIND","B2N5VDISX","B2N5VDISY","B2N5VDISZ","B2N5VINDX","B2N5VINDY","B2N5VREL ", & "B2N5VUNDX","B2N5VUNDY","B2N5VUNDZ","B2N6ALPHA","B2N6AXIND","B2N6CD ","B2N6CL ", & "B2N6CLRNC","B2N6CM ","B2N6CN ","B2N6CPMIN","B2N6CT ","B2N6CURVE","B2N6CX ", & "B2N6CY ","B2N6DYNP ","B2N6FD ","B2N6FL ","B2N6FN ","B2N6FT ","B2N6FX ", & - "B2N6FY ","B2N6M ","B2N6MM ","B2N6PHI ","B2N6RE ","B2N6SGCAV","B2N6SIGCR", & - "B2N6STVX ","B2N6STVY ","B2N6STVZ ","B2N6THETA","B2N6TNIND","B2N6VDISX","B2N6VDISY", & - "B2N6VDISZ","B2N6VINDX","B2N6VINDY","B2N6VREL ","B2N6VUNDX","B2N6VUNDY","B2N6VUNDZ", & - "B2N7ALPHA","B2N7AXIND","B2N7CD ","B2N7CL ","B2N7CLRNC","B2N7CM ","B2N7CN ", & - "B2N7CPMIN","B2N7CT ","B2N7CURVE","B2N7CX ","B2N7CY ","B2N7DYNP ","B2N7FD ", & - "B2N7FL ","B2N7FN ","B2N7FT ","B2N7FX ","B2N7FY ","B2N7M ","B2N7MM ", & - "B2N7PHI ","B2N7RE ","B2N7SGCAV","B2N7SIGCR","B2N7STVX ","B2N7STVY ","B2N7STVZ ", & - "B2N7THETA","B2N7TNIND","B2N7VDISX","B2N7VDISY","B2N7VDISZ","B2N7VINDX","B2N7VINDY", & - "B2N7VREL ","B2N7VUNDX","B2N7VUNDY","B2N7VUNDZ","B2N8ALPHA","B2N8AXIND","B2N8CD ", & - "B2N8CL ","B2N8CLRNC","B2N8CM ","B2N8CN ","B2N8CPMIN","B2N8CT ","B2N8CURVE", & - "B2N8CX ","B2N8CY ","B2N8DYNP ","B2N8FD ","B2N8FL ","B2N8FN ","B2N8FT ", & - "B2N8FX ","B2N8FY ","B2N8M ","B2N8MM ","B2N8PHI ","B2N8RE ","B2N8SGCAV", & - "B2N8SIGCR","B2N8STVX ","B2N8STVY ","B2N8STVZ ","B2N8THETA","B2N8TNIND","B2N8VDISX", & - "B2N8VDISY","B2N8VDISZ","B2N8VINDX","B2N8VINDY","B2N8VREL ","B2N8VUNDX","B2N8VUNDY", & - "B2N8VUNDZ","B2N9ALPHA","B2N9AXIND","B2N9CD ","B2N9CL ","B2N9CLRNC","B2N9CM ", & - "B2N9CN ","B2N9CPMIN","B2N9CT ","B2N9CURVE","B2N9CX ","B2N9CY ","B2N9DYNP ", & - "B2N9FD ","B2N9FL ","B2N9FN ","B2N9FT ","B2N9FX ","B2N9FY ","B2N9M ", & - "B2N9MM ","B2N9PHI ","B2N9RE ","B2N9SGCAV","B2N9SIGCR","B2N9STVX ","B2N9STVY ", & - "B2N9STVZ ","B2N9THETA","B2N9TNIND","B2N9VDISX","B2N9VDISY","B2N9VDISZ","B2N9VINDX", & - "B2N9VINDY","B2N9VREL ","B2N9VUNDX","B2N9VUNDY","B2N9VUNDZ","B2PITCH ","B3AZIMUTH", & - "B3N1ALPHA","B3N1AXIND","B3N1CD ","B3N1CL ","B3N1CLRNC","B3N1CM ","B3N1CN ", & - "B3N1CPMIN","B3N1CT ","B3N1CURVE","B3N1CX ","B3N1CY ","B3N1DYNP ","B3N1FD ", & - "B3N1FL ","B3N1FN ","B3N1FT ","B3N1FX ","B3N1FY ","B3N1M ","B3N1MM ", & - "B3N1PHI ","B3N1RE ","B3N1SGCAV","B3N1SIGCR","B3N1STVX ","B3N1STVY ","B3N1STVZ ", & - "B3N1THETA","B3N1TNIND","B3N1VDISX","B3N1VDISY","B3N1VDISZ","B3N1VINDX","B3N1VINDY", & - "B3N1VREL ","B3N1VUNDX","B3N1VUNDY","B3N1VUNDZ","B3N2ALPHA","B3N2AXIND","B3N2CD ", & - "B3N2CL ","B3N2CLRNC","B3N2CM ","B3N2CN ","B3N2CPMIN","B3N2CT ","B3N2CURVE", & - "B3N2CX ","B3N2CY ","B3N2DYNP ","B3N2FD ","B3N2FL ","B3N2FN ","B3N2FT ", & - "B3N2FX ","B3N2FY ","B3N2M ","B3N2MM ","B3N2PHI ","B3N2RE ","B3N2SGCAV", & - "B3N2SIGCR","B3N2STVX ","B3N2STVY ","B3N2STVZ ","B3N2THETA","B3N2TNIND","B3N2VDISX", & - "B3N2VDISY","B3N2VDISZ","B3N2VINDX","B3N2VINDY","B3N2VREL ","B3N2VUNDX","B3N2VUNDY", & - "B3N2VUNDZ","B3N3ALPHA","B3N3AXIND","B3N3CD ","B3N3CL ","B3N3CLRNC","B3N3CM ", & - "B3N3CN ","B3N3CPMIN","B3N3CT ","B3N3CURVE","B3N3CX ","B3N3CY ","B3N3DYNP ", & - "B3N3FD ","B3N3FL ","B3N3FN ","B3N3FT ","B3N3FX ","B3N3FY ","B3N3M ", & + "B2N6FY ","B2N6GAM ","B2N6M ","B2N6MM ","B2N6PHI ","B2N6RE ","B2N6SGCAV", & + "B2N6SIGCR","B2N6STVX ","B2N6STVY ","B2N6STVZ ","B2N6THETA","B2N6TNIND","B2N6VDISX", & + "B2N6VDISY","B2N6VDISZ","B2N6VINDX","B2N6VINDY","B2N6VREL ","B2N6VUNDX","B2N6VUNDY", & + "B2N6VUNDZ","B2N7ALPHA","B2N7AXIND","B2N7CD ","B2N7CL ","B2N7CLRNC","B2N7CM ", & + "B2N7CN ","B2N7CPMIN","B2N7CT ","B2N7CURVE","B2N7CX ","B2N7CY ","B2N7DYNP ", & + "B2N7FD ","B2N7FL ","B2N7FN ","B2N7FT ","B2N7FX ","B2N7FY ","B2N7GAM ", & + "B2N7M ","B2N7MM ","B2N7PHI ","B2N7RE ","B2N7SGCAV","B2N7SIGCR","B2N7STVX ", & + "B2N7STVY ","B2N7STVZ ","B2N7THETA","B2N7TNIND","B2N7VDISX","B2N7VDISY","B2N7VDISZ", & + "B2N7VINDX","B2N7VINDY","B2N7VREL ","B2N7VUNDX","B2N7VUNDY","B2N7VUNDZ","B2N8ALPHA", & + "B2N8AXIND","B2N8CD ","B2N8CL ","B2N8CLRNC","B2N8CM ","B2N8CN ","B2N8CPMIN", & + "B2N8CT ","B2N8CURVE","B2N8CX ","B2N8CY ","B2N8DYNP ","B2N8FD ","B2N8FL ", & + "B2N8FN ","B2N8FT ","B2N8FX ","B2N8FY ","B2N8GAM ","B2N8M ","B2N8MM ", & + "B2N8PHI ","B2N8RE ","B2N8SGCAV","B2N8SIGCR","B2N8STVX ","B2N8STVY ","B2N8STVZ ", & + "B2N8THETA","B2N8TNIND","B2N8VDISX","B2N8VDISY","B2N8VDISZ","B2N8VINDX","B2N8VINDY", & + "B2N8VREL ","B2N8VUNDX","B2N8VUNDY","B2N8VUNDZ","B2N9ALPHA","B2N9AXIND","B2N9CD ", & + "B2N9CL ","B2N9CLRNC","B2N9CM ","B2N9CN ","B2N9CPMIN","B2N9CT ","B2N9CURVE", & + "B2N9CX ","B2N9CY ","B2N9DYNP ","B2N9FD ","B2N9FL ","B2N9FN ","B2N9FT ", & + "B2N9FX ","B2N9FY ","B2N9GAM ","B2N9M ","B2N9MM ","B2N9PHI ","B2N9RE ", & + "B2N9SGCAV","B2N9SIGCR","B2N9STVX ","B2N9STVY ","B2N9STVZ ","B2N9THETA","B2N9TNIND", & + "B2N9VDISX","B2N9VDISY","B2N9VDISZ","B2N9VINDX","B2N9VINDY","B2N9VREL ","B2N9VUNDX", & + "B2N9VUNDY","B2N9VUNDZ","B2PITCH ","B3AZIMUTH","B3N1ALPHA","B3N1AXIND","B3N1CD ", & + "B3N1CL ","B3N1CLRNC","B3N1CM ","B3N1CN ","B3N1CPMIN","B3N1CT ","B3N1CURVE", & + "B3N1CX ","B3N1CY ","B3N1DYNP ","B3N1FD ","B3N1FL ","B3N1FN ","B3N1FT ", & + "B3N1FX ","B3N1FY ","B3N1GAM ","B3N1M ","B3N1MM ","B3N1PHI ","B3N1RE ", & + "B3N1SGCAV","B3N1SIGCR","B3N1STVX ","B3N1STVY ","B3N1STVZ ","B3N1THETA","B3N1TNIND", & + "B3N1VDISX","B3N1VDISY","B3N1VDISZ","B3N1VINDX","B3N1VINDY","B3N1VREL ","B3N1VUNDX", & + "B3N1VUNDY","B3N1VUNDZ","B3N2ALPHA","B3N2AXIND","B3N2CD ","B3N2CL ","B3N2CLRNC", & + "B3N2CM ","B3N2CN ","B3N2CPMIN","B3N2CT ","B3N2CURVE","B3N2CX ","B3N2CY ", & + "B3N2DYNP ","B3N2FD ","B3N2FL ","B3N2FN ","B3N2FT ","B3N2FX ","B3N2FY ", & + "B3N2GAM ","B3N2M ","B3N2MM ","B3N2PHI ","B3N2RE ","B3N2SGCAV","B3N2SIGCR", & + "B3N2STVX ","B3N2STVY ","B3N2STVZ ","B3N2THETA","B3N2TNIND","B3N2VDISX","B3N2VDISY", & + "B3N2VDISZ","B3N2VINDX","B3N2VINDY","B3N2VREL ","B3N2VUNDX","B3N2VUNDY","B3N2VUNDZ", & + "B3N3ALPHA","B3N3AXIND","B3N3CD ","B3N3CL ","B3N3CLRNC","B3N3CM ","B3N3CN ", & + "B3N3CPMIN","B3N3CT ","B3N3CURVE","B3N3CX ","B3N3CY ","B3N3DYNP ","B3N3FD ", & + "B3N3FL ","B3N3FN ","B3N3FT ","B3N3FX ","B3N3FY ","B3N3GAM ","B3N3M ", & "B3N3MM ","B3N3PHI ","B3N3RE ","B3N3SGCAV","B3N3SIGCR","B3N3STVX ","B3N3STVY ", & "B3N3STVZ ","B3N3THETA","B3N3TNIND","B3N3VDISX","B3N3VDISY","B3N3VDISZ","B3N3VINDX", & "B3N3VINDY","B3N3VREL ","B3N3VUNDX","B3N3VUNDY","B3N3VUNDZ","B3N4ALPHA","B3N4AXIND", & "B3N4CD ","B3N4CL ","B3N4CLRNC","B3N4CM ","B3N4CN ","B3N4CPMIN","B3N4CT ", & "B3N4CURVE","B3N4CX ","B3N4CY ","B3N4DYNP ","B3N4FD ","B3N4FL ","B3N4FN ", & - "B3N4FT ","B3N4FX ","B3N4FY ","B3N4M ","B3N4MM ","B3N4PHI ","B3N4RE ", & - "B3N4SGCAV","B3N4SIGCR","B3N4STVX ","B3N4STVY ","B3N4STVZ ","B3N4THETA","B3N4TNIND", & - "B3N4VDISX","B3N4VDISY","B3N4VDISZ","B3N4VINDX","B3N4VINDY","B3N4VREL ","B3N4VUNDX", & - "B3N4VUNDY","B3N4VUNDZ","B3N5ALPHA","B3N5AXIND","B3N5CD ","B3N5CL ","B3N5CLRNC", & - "B3N5CM ","B3N5CN ","B3N5CPMIN","B3N5CT ","B3N5CURVE","B3N5CX ","B3N5CY ", & - "B3N5DYNP ","B3N5FD ","B3N5FL ","B3N5FN ","B3N5FT ","B3N5FX ","B3N5FY ", & - "B3N5M ","B3N5MM ","B3N5PHI ","B3N5RE ","B3N5SGCAV","B3N5SIGCR","B3N5STVX ", & - "B3N5STVY ","B3N5STVZ ","B3N5THETA","B3N5TNIND","B3N5VDISX","B3N5VDISY","B3N5VDISZ", & - "B3N5VINDX","B3N5VINDY","B3N5VREL ","B3N5VUNDX","B3N5VUNDY","B3N5VUNDZ","B3N6ALPHA", & - "B3N6AXIND","B3N6CD ","B3N6CL ","B3N6CLRNC","B3N6CM ","B3N6CN ","B3N6CPMIN", & - "B3N6CT ","B3N6CURVE","B3N6CX ","B3N6CY ","B3N6DYNP ","B3N6FD ","B3N6FL ", & - "B3N6FN ","B3N6FT ","B3N6FX ","B3N6FY ","B3N6M ","B3N6MM ","B3N6PHI ", & - "B3N6RE ","B3N6SGCAV","B3N6SIGCR","B3N6STVX ","B3N6STVY ","B3N6STVZ ","B3N6THETA", & - "B3N6TNIND","B3N6VDISX","B3N6VDISY","B3N6VDISZ","B3N6VINDX","B3N6VINDY","B3N6VREL ", & - "B3N6VUNDX","B3N6VUNDY","B3N6VUNDZ","B3N7ALPHA","B3N7AXIND","B3N7CD ","B3N7CL ", & - "B3N7CLRNC","B3N7CM ","B3N7CN ","B3N7CPMIN","B3N7CT ","B3N7CURVE","B3N7CX ", & - "B3N7CY ","B3N7DYNP ","B3N7FD ","B3N7FL ","B3N7FN ","B3N7FT ","B3N7FX ", & - "B3N7FY ","B3N7M ","B3N7MM ","B3N7PHI ","B3N7RE ","B3N7SGCAV","B3N7SIGCR", & - "B3N7STVX ","B3N7STVY ","B3N7STVZ ","B3N7THETA","B3N7TNIND","B3N7VDISX","B3N7VDISY", & - "B3N7VDISZ","B3N7VINDX","B3N7VINDY","B3N7VREL ","B3N7VUNDX","B3N7VUNDY","B3N7VUNDZ", & - "B3N8ALPHA","B3N8AXIND","B3N8CD ","B3N8CL ","B3N8CLRNC","B3N8CM ","B3N8CN ", & - "B3N8CPMIN","B3N8CT ","B3N8CURVE","B3N8CX ","B3N8CY ","B3N8DYNP ","B3N8FD ", & - "B3N8FL ","B3N8FN ","B3N8FT ","B3N8FX ","B3N8FY ","B3N8M ","B3N8MM ", & - "B3N8PHI ","B3N8RE ","B3N8SGCAV","B3N8SIGCR","B3N8STVX ","B3N8STVY ","B3N8STVZ ", & - "B3N8THETA","B3N8TNIND","B3N8VDISX","B3N8VDISY","B3N8VDISZ","B3N8VINDX","B3N8VINDY", & - "B3N8VREL ","B3N8VUNDX","B3N8VUNDY","B3N8VUNDZ","B3N9ALPHA","B3N9AXIND","B3N9CD ", & - "B3N9CL ","B3N9CLRNC","B3N9CM ","B3N9CN ","B3N9CPMIN","B3N9CT ","B3N9CURVE", & - "B3N9CX ","B3N9CY ","B3N9DYNP ","B3N9FD ","B3N9FL ","B3N9FN ","B3N9FT ", & - "B3N9FX ","B3N9FY ","B3N9M ","B3N9MM ","B3N9PHI ","B3N9RE ","B3N9SGCAV", & - "B3N9SIGCR","B3N9STVX ","B3N9STVY ","B3N9STVZ ","B3N9THETA","B3N9TNIND","B3N9VDISX", & - "B3N9VDISY","B3N9VDISZ","B3N9VINDX","B3N9VINDY","B3N9VREL ","B3N9VUNDX","B3N9VUNDY", & - "B3N9VUNDZ","B3PITCH ","RTAEROCP ","RTAEROCQ ","RTAEROCT ","RTAEROFXH","RTAEROFYH", & - "RTAEROFZH","RTAEROMXH","RTAEROMYH","RTAEROMZH","RTAEROPWR","RTAREA ","RTSKEW ", & - "RTSPEED ","RTTSR ","RTVAVGXH ","RTVAVGYH ","RTVAVGZH ","TWN1DYNP ","TWN1FDX ", & - "TWN1FDY ","TWN1M ","TWN1RE ","TWN1STVX ","TWN1STVY ","TWN1STVZ ","TWN1VREL ", & - "TWN1VUNDX","TWN1VUNDY","TWN1VUNDZ","TWN2DYNP ","TWN2FDX ","TWN2FDY ","TWN2M ", & - "TWN2RE ","TWN2STVX ","TWN2STVY ","TWN2STVZ ","TWN2VREL ","TWN2VUNDX","TWN2VUNDY", & - "TWN2VUNDZ","TWN3DYNP ","TWN3FDX ","TWN3FDY ","TWN3M ","TWN3RE ","TWN3STVX ", & - "TWN3STVY ","TWN3STVZ ","TWN3VREL ","TWN3VUNDX","TWN3VUNDY","TWN3VUNDZ","TWN4DYNP ", & - "TWN4FDX ","TWN4FDY ","TWN4M ","TWN4RE ","TWN4STVX ","TWN4STVY ","TWN4STVZ ", & - "TWN4VREL ","TWN4VUNDX","TWN4VUNDY","TWN4VUNDZ","TWN5DYNP ","TWN5FDX ","TWN5FDY ", & - "TWN5M ","TWN5RE ","TWN5STVX ","TWN5STVY ","TWN5STVZ ","TWN5VREL ","TWN5VUNDX", & - "TWN5VUNDY","TWN5VUNDZ","TWN6DYNP ","TWN6FDX ","TWN6FDY ","TWN6M ","TWN6RE ", & - "TWN6STVX ","TWN6STVY ","TWN6STVZ ","TWN6VREL ","TWN6VUNDX","TWN6VUNDY","TWN6VUNDZ", & - "TWN7DYNP ","TWN7FDX ","TWN7FDY ","TWN7M ","TWN7RE ","TWN7STVX ","TWN7STVY ", & - "TWN7STVZ ","TWN7VREL ","TWN7VUNDX","TWN7VUNDY","TWN7VUNDZ","TWN8DYNP ","TWN8FDX ", & - "TWN8FDY ","TWN8M ","TWN8RE ","TWN8STVX ","TWN8STVY ","TWN8STVZ ","TWN8VREL ", & - "TWN8VUNDX","TWN8VUNDY","TWN8VUNDZ","TWN9DYNP ","TWN9FDX ","TWN9FDY ","TWN9M ", & - "TWN9RE ","TWN9STVX ","TWN9STVY ","TWN9STVZ ","TWN9VREL ","TWN9VUNDX","TWN9VUNDY", & - "TWN9VUNDZ"/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(1184) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + "B3N4FT ","B3N4FX ","B3N4FY ","B3N4GAM ","B3N4M ","B3N4MM ","B3N4PHI ", & + "B3N4RE ","B3N4SGCAV","B3N4SIGCR","B3N4STVX ","B3N4STVY ","B3N4STVZ ","B3N4THETA", & + "B3N4TNIND","B3N4VDISX","B3N4VDISY","B3N4VDISZ","B3N4VINDX","B3N4VINDY","B3N4VREL ", & + "B3N4VUNDX","B3N4VUNDY","B3N4VUNDZ","B3N5ALPHA","B3N5AXIND","B3N5CD ","B3N5CL ", & + "B3N5CLRNC","B3N5CM ","B3N5CN ","B3N5CPMIN","B3N5CT ","B3N5CURVE","B3N5CX ", & + "B3N5CY ","B3N5DYNP ","B3N5FD ","B3N5FL ","B3N5FN ","B3N5FT ","B3N5FX ", & + "B3N5FY ","B3N5GAM ","B3N5M ","B3N5MM ","B3N5PHI ","B3N5RE ","B3N5SGCAV", & + "B3N5SIGCR","B3N5STVX ","B3N5STVY ","B3N5STVZ ","B3N5THETA","B3N5TNIND","B3N5VDISX", & + "B3N5VDISY","B3N5VDISZ","B3N5VINDX","B3N5VINDY","B3N5VREL ","B3N5VUNDX","B3N5VUNDY", & + "B3N5VUNDZ","B3N6ALPHA","B3N6AXIND","B3N6CD ","B3N6CL ","B3N6CLRNC","B3N6CM ", & + "B3N6CN ","B3N6CPMIN","B3N6CT ","B3N6CURVE","B3N6CX ","B3N6CY ","B3N6DYNP ", & + "B3N6FD ","B3N6FL ","B3N6FN ","B3N6FT ","B3N6FX ","B3N6FY ","B3N6GAM ", & + "B3N6M ","B3N6MM ","B3N6PHI ","B3N6RE ","B3N6SGCAV","B3N6SIGCR","B3N6STVX ", & + "B3N6STVY ","B3N6STVZ ","B3N6THETA","B3N6TNIND","B3N6VDISX","B3N6VDISY","B3N6VDISZ", & + "B3N6VINDX","B3N6VINDY","B3N6VREL ","B3N6VUNDX","B3N6VUNDY","B3N6VUNDZ","B3N7ALPHA", & + "B3N7AXIND","B3N7CD ","B3N7CL ","B3N7CLRNC","B3N7CM ","B3N7CN ","B3N7CPMIN", & + "B3N7CT ","B3N7CURVE","B3N7CX ","B3N7CY ","B3N7DYNP ","B3N7FD ","B3N7FL ", & + "B3N7FN ","B3N7FT ","B3N7FX ","B3N7FY ","B3N7GAM ","B3N7M ","B3N7MM ", & + "B3N7PHI ","B3N7RE ","B3N7SGCAV","B3N7SIGCR","B3N7STVX ","B3N7STVY ","B3N7STVZ ", & + "B3N7THETA","B3N7TNIND","B3N7VDISX","B3N7VDISY","B3N7VDISZ","B3N7VINDX","B3N7VINDY", & + "B3N7VREL ","B3N7VUNDX","B3N7VUNDY","B3N7VUNDZ","B3N8ALPHA","B3N8AXIND","B3N8CD ", & + "B3N8CL ","B3N8CLRNC","B3N8CM ","B3N8CN ","B3N8CPMIN","B3N8CT ","B3N8CURVE", & + "B3N8CX ","B3N8CY ","B3N8DYNP ","B3N8FD ","B3N8FL ","B3N8FN ","B3N8FT ", & + "B3N8FX ","B3N8FY ","B3N8GAM ","B3N8M ","B3N8MM ","B3N8PHI ","B3N8RE ", & + "B3N8SGCAV","B3N8SIGCR","B3N8STVX ","B3N8STVY ","B3N8STVZ ","B3N8THETA","B3N8TNIND", & + "B3N8VDISX","B3N8VDISY","B3N8VDISZ","B3N8VINDX","B3N8VINDY","B3N8VREL ","B3N8VUNDX", & + "B3N8VUNDY","B3N8VUNDZ","B3N9ALPHA","B3N9AXIND","B3N9CD ","B3N9CL ","B3N9CLRNC", & + "B3N9CM ","B3N9CN ","B3N9CPMIN","B3N9CT ","B3N9CURVE","B3N9CX ","B3N9CY ", & + "B3N9DYNP ","B3N9FD ","B3N9FL ","B3N9FN ","B3N9FT ","B3N9FX ","B3N9FY ", & + "B3N9GAM ","B3N9M ","B3N9MM ","B3N9PHI ","B3N9RE ","B3N9SGCAV","B3N9SIGCR", & + "B3N9STVX ","B3N9STVY ","B3N9STVZ ","B3N9THETA","B3N9TNIND","B3N9VDISX","B3N9VDISY", & + "B3N9VDISZ","B3N9VINDX","B3N9VINDY","B3N9VREL ","B3N9VUNDX","B3N9VUNDY","B3N9VUNDZ", & + "B3PITCH ","RTAEROCP ","RTAEROCQ ","RTAEROCT ","RTAEROFXH","RTAEROFYH","RTAEROFZH", & + "RTAEROMXH","RTAEROMYH","RTAEROMZH","RTAEROPWR","RTAREA ","RTSKEW ","RTSPEED ", & + "RTTSR ","RTVAVGXH ","RTVAVGYH ","RTVAVGZH ","TWN1DYNP ","TWN1FDX ","TWN1FDY ", & + "TWN1M ","TWN1RE ","TWN1STVX ","TWN1STVY ","TWN1STVZ ","TWN1VREL ","TWN1VUNDX", & + "TWN1VUNDY","TWN1VUNDZ","TWN2DYNP ","TWN2FDX ","TWN2FDY ","TWN2M ","TWN2RE ", & + "TWN2STVX ","TWN2STVY ","TWN2STVZ ","TWN2VREL ","TWN2VUNDX","TWN2VUNDY","TWN2VUNDZ", & + "TWN3DYNP ","TWN3FDX ","TWN3FDY ","TWN3M ","TWN3RE ","TWN3STVX ","TWN3STVY ", & + "TWN3STVZ ","TWN3VREL ","TWN3VUNDX","TWN3VUNDY","TWN3VUNDZ","TWN4DYNP ","TWN4FDX ", & + "TWN4FDY ","TWN4M ","TWN4RE ","TWN4STVX ","TWN4STVY ","TWN4STVZ ","TWN4VREL ", & + "TWN4VUNDX","TWN4VUNDY","TWN4VUNDZ","TWN5DYNP ","TWN5FDX ","TWN5FDY ","TWN5M ", & + "TWN5RE ","TWN5STVX ","TWN5STVY ","TWN5STVZ ","TWN5VREL ","TWN5VUNDX","TWN5VUNDY", & + "TWN5VUNDZ","TWN6DYNP ","TWN6FDX ","TWN6FDY ","TWN6M ","TWN6RE ","TWN6STVX ", & + "TWN6STVY ","TWN6STVZ ","TWN6VREL ","TWN6VUNDX","TWN6VUNDY","TWN6VUNDZ","TWN7DYNP ", & + "TWN7FDX ","TWN7FDY ","TWN7M ","TWN7RE ","TWN7STVX ","TWN7STVY ","TWN7STVZ ", & + "TWN7VREL ","TWN7VUNDX","TWN7VUNDY","TWN7VUNDZ","TWN8DYNP ","TWN8FDX ","TWN8FDY ", & + "TWN8M ","TWN8RE ","TWN8STVX ","TWN8STVY ","TWN8STVZ ","TWN8VREL ","TWN8VUNDX", & + "TWN8VUNDY","TWN8VUNDZ","TWN9DYNP ","TWN9FDX ","TWN9FDY ","TWN9M ","TWN9RE ", & + "TWN9STVX ","TWN9STVY ","TWN9STVZ ","TWN9VREL ","TWN9VUNDX","TWN9VUNDY","TWN9VUNDZ"/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(1211) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) B1Azimuth , B1N1Alpha , B1N1AxInd , B1N1Cd , B1N1Cl , B1N1Clrnc , B1N1Cm , & B1N1Cn , B1N1Cpmin , B1N1Ct , B1N1Curve , B1N1Cx , B1N1Cy , B1N1DynP , & - B1N1Fd , B1N1Fl , B1N1Fn , B1N1Ft , B1N1Fx , B1N1Fy , B1N1M , & - B1N1Mm , B1N1Phi , B1N1Re , B1N1SgCav , B1N1SigCr , B1N1STVx , B1N1STVy , & - B1N1STVz , B1N1Theta , B1N1TnInd , B1N1VDisx , B1N1VDisy , B1N1VDisz , B1N1Vindx , & - B1N1Vindy , B1N1VRel , B1N1VUndx , B1N1VUndy , B1N1VUndz , B1N2Alpha , B1N2AxInd , & - B1N2Cd , B1N2Cl , B1N2Clrnc , B1N2Cm , B1N2Cn , B1N2Cpmin , B1N2Ct , & - B1N2Curve , B1N2Cx , B1N2Cy , B1N2DynP , B1N2Fd , B1N2Fl , B1N2Fn , & - B1N2Ft , B1N2Fx , B1N2Fy , B1N2M , B1N2Mm , B1N2Phi , B1N2Re , & - B1N2SgCav , B1N2SigCr , B1N2STVx , B1N2STVy , B1N2STVz , B1N2Theta , B1N2TnInd , & - B1N2VDisx , B1N2VDisy , B1N2VDisz , B1N2Vindx , B1N2Vindy , B1N2VRel , B1N2VUndx , & - B1N2VUndy , B1N2VUndz , B1N3Alpha , B1N3AxInd , B1N3Cd , B1N3Cl , B1N3Clrnc , & - B1N3Cm , B1N3Cn , B1N3Cpmin , B1N3Ct , B1N3Curve , B1N3Cx , B1N3Cy , & - B1N3DynP , B1N3Fd , B1N3Fl , B1N3Fn , B1N3Ft , B1N3Fx , B1N3Fy , & - B1N3M , B1N3Mm , B1N3Phi , B1N3Re , B1N3SgCav , B1N3SigCr , B1N3STVx , & - B1N3STVy , B1N3STVz , B1N3Theta , B1N3TnInd , B1N3VDisx , B1N3VDisy , B1N3VDisz , & - B1N3Vindx , B1N3Vindy , B1N3VRel , B1N3VUndx , B1N3VUndy , B1N3VUndz , B1N4Alpha , & - B1N4AxInd , B1N4Cd , B1N4Cl , B1N4Clrnc , B1N4Cm , B1N4Cn , B1N4Cpmin , & - B1N4Ct , B1N4Curve , B1N4Cx , B1N4Cy , B1N4DynP , B1N4Fd , B1N4Fl , & - B1N4Fn , B1N4Ft , B1N4Fx , B1N4Fy , B1N4M , B1N4Mm , B1N4Phi , & - B1N4Re , B1N4SgCav , B1N4SigCr , B1N4STVx , B1N4STVy , B1N4STVz , B1N4Theta , & - B1N4TnInd , B1N4VDisx , B1N4VDisy , B1N4VDisz , B1N4Vindx , B1N4Vindy , B1N4VRel , & - B1N4VUndx , B1N4VUndy , B1N4VUndz , B1N5Alpha , B1N5AxInd , B1N5Cd , B1N5Cl , & - B1N5Clrnc , B1N5Cm , B1N5Cn , B1N5Cpmin , B1N5Ct , B1N5Curve , B1N5Cx , & - B1N5Cy , B1N5DynP , B1N5Fd , B1N5Fl , B1N5Fn , B1N5Ft , B1N5Fx , & - B1N5Fy , B1N5M , B1N5Mm , B1N5Phi , B1N5Re , B1N5SgCav , B1N5SigCr , & - B1N5STVx , B1N5STVy , B1N5STVz , B1N5Theta , B1N5TnInd , B1N5VDisx , B1N5VDisy , & - B1N5VDisz , B1N5Vindx , B1N5Vindy , B1N5VRel , B1N5VUndx , B1N5VUndy , B1N5VUndz , & - B1N6Alpha , B1N6AxInd , B1N6Cd , B1N6Cl , B1N6Clrnc , B1N6Cm , B1N6Cn , & - B1N6Cpmin , B1N6Ct , B1N6Curve , B1N6Cx , B1N6Cy , B1N6DynP , B1N6Fd , & - B1N6Fl , B1N6Fn , B1N6Ft , B1N6Fx , B1N6Fy , B1N6M , B1N6Mm , & - B1N6Phi , B1N6Re , B1N6SgCav , B1N6SigCr , B1N6STVx , B1N6STVy , B1N6STVz , & - B1N6Theta , B1N6TnInd , B1N6VDisx , B1N6VDisy , B1N6VDisz , B1N6Vindx , B1N6Vindy , & - B1N6VRel , B1N6VUndx , B1N6VUndy , B1N6VUndz , B1N7Alpha , B1N7AxInd , B1N7Cd , & - B1N7Cl , B1N7Clrnc , B1N7Cm , B1N7Cn , B1N7Cpmin , B1N7Ct , B1N7Curve , & - B1N7Cx , B1N7Cy , B1N7DynP , B1N7Fd , B1N7Fl , B1N7Fn , B1N7Ft , & - B1N7Fx , B1N7Fy , B1N7M , B1N7Mm , B1N7Phi , B1N7Re , B1N7SgCav , & + B1N1Fd , B1N1Fl , B1N1Fn , B1N1Ft , B1N1Fx , B1N1Fy , B1N1Gam , & + B1N1M , B1N1Mm , B1N1Phi , B1N1Re , B1N1SgCav , B1N1SigCr , B1N1STVx , & + B1N1STVy , B1N1STVz , B1N1Theta , B1N1TnInd , B1N1VDisx , B1N1VDisy , B1N1VDisz , & + B1N1Vindx , B1N1Vindy , B1N1VRel , B1N1VUndx , B1N1VUndy , B1N1VUndz , B1N2Alpha , & + B1N2AxInd , B1N2Cd , B1N2Cl , B1N2Clrnc , B1N2Cm , B1N2Cn , B1N2Cpmin , & + B1N2Ct , B1N2Curve , B1N2Cx , B1N2Cy , B1N2DynP , B1N2Fd , B1N2Fl , & + B1N2Fn , B1N2Ft , B1N2Fx , B1N2Fy , B1N2Gam , B1N2M , B1N2Mm , & + B1N2Phi , B1N2Re , B1N2SgCav , B1N2SigCr , B1N2STVx , B1N2STVy , B1N2STVz , & + B1N2Theta , B1N2TnInd , B1N2VDisx , B1N2VDisy , B1N2VDisz , B1N2Vindx , B1N2Vindy , & + B1N2VRel , B1N2VUndx , B1N2VUndy , B1N2VUndz , B1N3Alpha , B1N3AxInd , B1N3Cd , & + B1N3Cl , B1N3Clrnc , B1N3Cm , B1N3Cn , B1N3Cpmin , B1N3Ct , B1N3Curve , & + B1N3Cx , B1N3Cy , B1N3DynP , B1N3Fd , B1N3Fl , B1N3Fn , B1N3Ft , & + B1N3Fx , B1N3Fy , B1N3Gam , B1N3M , B1N3Mm , B1N3Phi , B1N3Re , & + B1N3SgCav , B1N3SigCr , B1N3STVx , B1N3STVy , B1N3STVz , B1N3Theta , B1N3TnInd , & + B1N3VDisx , B1N3VDisy , B1N3VDisz , B1N3Vindx , B1N3Vindy , B1N3VRel , B1N3VUndx , & + B1N3VUndy , B1N3VUndz , B1N4Alpha , B1N4AxInd , B1N4Cd , B1N4Cl , B1N4Clrnc , & + B1N4Cm , B1N4Cn , B1N4Cpmin , B1N4Ct , B1N4Curve , B1N4Cx , B1N4Cy , & + B1N4DynP , B1N4Fd , B1N4Fl , B1N4Fn , B1N4Ft , B1N4Fx , B1N4Fy , & + B1N4Gam , B1N4M , B1N4Mm , B1N4Phi , B1N4Re , B1N4SgCav , B1N4SigCr , & + B1N4STVx , B1N4STVy , B1N4STVz , B1N4Theta , B1N4TnInd , B1N4VDisx , B1N4VDisy , & + B1N4VDisz , B1N4Vindx , B1N4Vindy , B1N4VRel , B1N4VUndx , B1N4VUndy , B1N4VUndz , & + B1N5Alpha , B1N5AxInd , B1N5Cd , B1N5Cl , B1N5Clrnc , B1N5Cm , B1N5Cn , & + B1N5Cpmin , B1N5Ct , B1N5Curve , B1N5Cx , B1N5Cy , B1N5DynP , B1N5Fd , & + B1N5Fl , B1N5Fn , B1N5Ft , B1N5Fx , B1N5Fy , B1N5Gam , B1N5M , & + B1N5Mm , B1N5Phi , B1N5Re , B1N5SgCav , B1N5SigCr , B1N5STVx , B1N5STVy , & + B1N5STVz , B1N5Theta , B1N5TnInd , B1N5VDisx , B1N5VDisy , B1N5VDisz , B1N5Vindx , & + B1N5Vindy , B1N5VRel , B1N5VUndx , B1N5VUndy , B1N5VUndz , B1N6Alpha , B1N6AxInd , & + B1N6Cd , B1N6Cl , B1N6Clrnc , B1N6Cm , B1N6Cn , B1N6Cpmin , B1N6Ct , & + B1N6Curve , B1N6Cx , B1N6Cy , B1N6DynP , B1N6Fd , B1N6Fl , B1N6Fn , & + B1N6Ft , B1N6Fx , B1N6Fy , B1N6Gam , B1N6M , B1N6Mm , B1N6Phi , & + B1N6Re , B1N6SgCav , B1N6SigCr , B1N6STVx , B1N6STVy , B1N6STVz , B1N6Theta , & + B1N6TnInd , B1N6VDisx , B1N6VDisy , B1N6VDisz , B1N6Vindx , B1N6Vindy , B1N6VRel , & + B1N6VUndx , B1N6VUndy , B1N6VUndz , B1N7Alpha , B1N7AxInd , B1N7Cd , B1N7Cl , & + B1N7Clrnc , B1N7Cm , B1N7Cn , B1N7Cpmin , B1N7Ct , B1N7Curve , B1N7Cx , & + B1N7Cy , B1N7DynP , B1N7Fd , B1N7Fl , B1N7Fn , B1N7Ft , B1N7Fx , & + B1N7Fy , B1N7Gam , B1N7M , B1N7Mm , B1N7Phi , B1N7Re , B1N7SgCav , & B1N7SigCr , B1N7STVx , B1N7STVy , B1N7STVz , B1N7Theta , B1N7TnInd , B1N7VDisx , & B1N7VDisy , B1N7VDisz , B1N7Vindx , B1N7Vindy , B1N7VRel , B1N7VUndx , B1N7VUndy , & B1N7VUndz , B1N8Alpha , B1N8AxInd , B1N8Cd , B1N8Cl , B1N8Clrnc , B1N8Cm , & B1N8Cn , B1N8Cpmin , B1N8Ct , B1N8Curve , B1N8Cx , B1N8Cy , B1N8DynP , & - B1N8Fd , B1N8Fl , B1N8Fn , B1N8Ft , B1N8Fx , B1N8Fy , B1N8M , & - B1N8Mm , B1N8Phi , B1N8Re , B1N8SgCav , B1N8SigCr , B1N8STVx , B1N8STVy , & - B1N8STVz , B1N8Theta , B1N8TnInd , B1N8VDisx , B1N8VDisy , B1N8VDisz , B1N8Vindx , & - B1N8Vindy , B1N8VRel , B1N8VUndx , B1N8VUndy , B1N8VUndz , B1N9Alpha , B1N9AxInd , & - B1N9Cd , B1N9Cl , B1N9Clrnc , B1N9Cm , B1N9Cn , B1N9Cpmin , B1N9Ct , & - B1N9Curve , B1N9Cx , B1N9Cy , B1N9DynP , B1N9Fd , B1N9Fl , B1N9Fn , & - B1N9Ft , B1N9Fx , B1N9Fy , B1N9M , B1N9Mm , B1N9Phi , B1N9Re , & - B1N9SgCav , B1N9SigCr , B1N9STVx , B1N9STVy , B1N9STVz , B1N9Theta , B1N9TnInd , & - B1N9VDisx , B1N9VDisy , B1N9VDisz , B1N9Vindx , B1N9Vindy , B1N9VRel , B1N9VUndx , & - B1N9VUndy , B1N9VUndz , B1Pitch , B2Azimuth , B2N1Alpha , B2N1AxInd , B2N1Cd , & - B2N1Cl , B2N1Clrnc , B2N1Cm , B2N1Cn , B2N1Cpmin , B2N1Ct , B2N1Curve , & - B2N1Cx , B2N1Cy , B2N1DynP , B2N1Fd , B2N1Fl , B2N1Fn , B2N1Ft , & - B2N1Fx , B2N1Fy , B2N1M , B2N1Mm , B2N1Phi , B2N1Re , B2N1SgCav , & - B2N1SigCr , B2N1STVx , B2N1STVy , B2N1STVz , B2N1Theta , B2N1TnInd , B2N1VDisx , & - B2N1VDisy , B2N1VDisz , B2N1Vindx , B2N1Vindy , B2N1VRel , B2N1VUndx , B2N1VUndy , & - B2N1VUndz , B2N2Alpha , B2N2AxInd , B2N2Cd , B2N2Cl , B2N2Clrnc , B2N2Cm , & - B2N2Cn , B2N2Cpmin , B2N2Ct , B2N2Curve , B2N2Cx , B2N2Cy , B2N2DynP , & - B2N2Fd , B2N2Fl , B2N2Fn , B2N2Ft , B2N2Fx , B2N2Fy , B2N2M , & - B2N2Mm , B2N2Phi , B2N2Re , B2N2SgCav , B2N2SigCr , B2N2STVx , B2N2STVy , & - B2N2STVz , B2N2Theta , B2N2TnInd , B2N2VDisx , B2N2VDisy , B2N2VDisz , B2N2Vindx , & - B2N2Vindy , B2N2VRel , B2N2VUndx , B2N2VUndy , B2N2VUndz , B2N3Alpha , B2N3AxInd , & - B2N3Cd , B2N3Cl , B2N3Clrnc , B2N3Cm , B2N3Cn , B2N3Cpmin , B2N3Ct , & - B2N3Curve , B2N3Cx , B2N3Cy , B2N3DynP , B2N3Fd , B2N3Fl , B2N3Fn , & - B2N3Ft , B2N3Fx , B2N3Fy , B2N3M , B2N3Mm , B2N3Phi , B2N3Re , & - B2N3SgCav , B2N3SigCr , B2N3STVx , B2N3STVy , B2N3STVz , B2N3Theta , B2N3TnInd , & - B2N3VDisx , B2N3VDisy , B2N3VDisz , B2N3Vindx , B2N3Vindy , B2N3VRel , B2N3VUndx , & - B2N3VUndy , B2N3VUndz , B2N4Alpha , B2N4AxInd , B2N4Cd , B2N4Cl , B2N4Clrnc , & - B2N4Cm , B2N4Cn , B2N4Cpmin , B2N4Ct , B2N4Curve , B2N4Cx , B2N4Cy , & - B2N4DynP , B2N4Fd , B2N4Fl , B2N4Fn , B2N4Ft , B2N4Fx , B2N4Fy , & - B2N4M , B2N4Mm , B2N4Phi , B2N4Re , B2N4SgCav , B2N4SigCr , B2N4STVx , & - B2N4STVy , B2N4STVz , B2N4Theta , B2N4TnInd , B2N4VDisx , B2N4VDisy , B2N4VDisz , & - B2N4Vindx , B2N4Vindy , B2N4VRel , B2N4VUndx , B2N4VUndy , B2N4VUndz , B2N5Alpha , & - B2N5AxInd , B2N5Cd , B2N5Cl , B2N5Clrnc , B2N5Cm , B2N5Cn , B2N5Cpmin , & - B2N5Ct , B2N5Curve , B2N5Cx , B2N5Cy , B2N5DynP , B2N5Fd , B2N5Fl , & - B2N5Fn , B2N5Ft , B2N5Fx , B2N5Fy , B2N5M , B2N5Mm , B2N5Phi , & + B1N8Fd , B1N8Fl , B1N8Fn , B1N8Ft , B1N8Fx , B1N8Fy , B1N8Gam , & + B1N8M , B1N8Mm , B1N8Phi , B1N8Re , B1N8SgCav , B1N8SigCr , B1N8STVx , & + B1N8STVy , B1N8STVz , B1N8Theta , B1N8TnInd , B1N8VDisx , B1N8VDisy , B1N8VDisz , & + B1N8Vindx , B1N8Vindy , B1N8VRel , B1N8VUndx , B1N8VUndy , B1N8VUndz , B1N9Alpha , & + B1N9AxInd , B1N9Cd , B1N9Cl , B1N9Clrnc , B1N9Cm , B1N9Cn , B1N9Cpmin , & + B1N9Ct , B1N9Curve , B1N9Cx , B1N9Cy , B1N9DynP , B1N9Fd , B1N9Fl , & + B1N9Fn , B1N9Ft , B1N9Fx , B1N9Fy , B1N9Gam , B1N9M , B1N9Mm , & + B1N9Phi , B1N9Re , B1N9SgCav , B1N9SigCr , B1N9STVx , B1N9STVy , B1N9STVz , & + B1N9Theta , B1N9TnInd , B1N9VDisx , B1N9VDisy , B1N9VDisz , B1N9Vindx , B1N9Vindy , & + B1N9VRel , B1N9VUndx , B1N9VUndy , B1N9VUndz , B1Pitch , B2Azimuth , B2N1Alpha , & + B2N1AxInd , B2N1Cd , B2N1Cl , B2N1Clrnc , B2N1Cm , B2N1Cn , B2N1Cpmin , & + B2N1Ct , B2N1Curve , B2N1Cx , B2N1Cy , B2N1DynP , B2N1Fd , B2N1Fl , & + B2N1Fn , B2N1Ft , B2N1Fx , B2N1Fy , B2N1Gam , B2N1M , B2N1Mm , & + B2N1Phi , B2N1Re , B2N1SgCav , B2N1SigCr , B2N1STVx , B2N1STVy , B2N1STVz , & + B2N1Theta , B2N1TnInd , B2N1VDisx , B2N1VDisy , B2N1VDisz , B2N1Vindx , B2N1Vindy , & + B2N1VRel , B2N1VUndx , B2N1VUndy , B2N1VUndz , B2N2Alpha , B2N2AxInd , B2N2Cd , & + B2N2Cl , B2N2Clrnc , B2N2Cm , B2N2Cn , B2N2Cpmin , B2N2Ct , B2N2Curve , & + B2N2Cx , B2N2Cy , B2N2DynP , B2N2Fd , B2N2Fl , B2N2Fn , B2N2Ft , & + B2N2Fx , B2N2Fy , B2N2Gam , B2N2M , B2N2Mm , B2N2Phi , B2N2Re , & + B2N2SgCav , B2N2SigCr , B2N2STVx , B2N2STVy , B2N2STVz , B2N2Theta , B2N2TnInd , & + B2N2VDisx , B2N2VDisy , B2N2VDisz , B2N2Vindx , B2N2Vindy , B2N2VRel , B2N2VUndx , & + B2N2VUndy , B2N2VUndz , B2N3Alpha , B2N3AxInd , B2N3Cd , B2N3Cl , B2N3Clrnc , & + B2N3Cm , B2N3Cn , B2N3Cpmin , B2N3Ct , B2N3Curve , B2N3Cx , B2N3Cy , & + B2N3DynP , B2N3Fd , B2N3Fl , B2N3Fn , B2N3Ft , B2N3Fx , B2N3Fy , & + B2N3Gam , B2N3M , B2N3Mm , B2N3Phi , B2N3Re , B2N3SgCav , B2N3SigCr , & + B2N3STVx , B2N3STVy , B2N3STVz , B2N3Theta , B2N3TnInd , B2N3VDisx , B2N3VDisy , & + B2N3VDisz , B2N3Vindx , B2N3Vindy , B2N3VRel , B2N3VUndx , B2N3VUndy , B2N3VUndz , & + B2N4Alpha , B2N4AxInd , B2N4Cd , B2N4Cl , B2N4Clrnc , B2N4Cm , B2N4Cn , & + B2N4Cpmin , B2N4Ct , B2N4Curve , B2N4Cx , B2N4Cy , B2N4DynP , B2N4Fd , & + B2N4Fl , B2N4Fn , B2N4Ft , B2N4Fx , B2N4Fy , B2N4Gam , B2N4M , & + B2N4Mm , B2N4Phi , B2N4Re , B2N4SgCav , B2N4SigCr , B2N4STVx , B2N4STVy , & + B2N4STVz , B2N4Theta , B2N4TnInd , B2N4VDisx , B2N4VDisy , B2N4VDisz , B2N4Vindx , & + B2N4Vindy , B2N4VRel , B2N4VUndx , B2N4VUndy , B2N4VUndz , B2N5Alpha , B2N5AxInd , & + B2N5Cd , B2N5Cl , B2N5Clrnc , B2N5Cm , B2N5Cn , B2N5Cpmin , B2N5Ct , & + B2N5Curve , B2N5Cx , B2N5Cy , B2N5DynP , B2N5Fd , B2N5Fl , B2N5Fn , & + B2N5Ft , B2N5Fx , B2N5Fy , B2N5Gam , B2N5M , B2N5Mm , B2N5Phi , & B2N5Re , B2N5SgCav , B2N5SigCr , B2N5STVx , B2N5STVy , B2N5STVz , B2N5Theta , & B2N5TnInd , B2N5VDisx , B2N5VDisy , B2N5VDisz , B2N5Vindx , B2N5Vindy , B2N5VRel , & B2N5VUndx , B2N5VUndy , B2N5VUndz , B2N6Alpha , B2N6AxInd , B2N6Cd , B2N6Cl , & B2N6Clrnc , B2N6Cm , B2N6Cn , B2N6Cpmin , B2N6Ct , B2N6Curve , B2N6Cx , & B2N6Cy , B2N6DynP , B2N6Fd , B2N6Fl , B2N6Fn , B2N6Ft , B2N6Fx , & - B2N6Fy , B2N6M , B2N6Mm , B2N6Phi , B2N6Re , B2N6SgCav , B2N6SigCr , & - B2N6STVx , B2N6STVy , B2N6STVz , B2N6Theta , B2N6TnInd , B2N6VDisx , B2N6VDisy , & - B2N6VDisz , B2N6Vindx , B2N6Vindy , B2N6VRel , B2N6VUndx , B2N6VUndy , B2N6VUndz , & - B2N7Alpha , B2N7AxInd , B2N7Cd , B2N7Cl , B2N7Clrnc , B2N7Cm , B2N7Cn , & - B2N7Cpmin , B2N7Ct , B2N7Curve , B2N7Cx , B2N7Cy , B2N7DynP , B2N7Fd , & - B2N7Fl , B2N7Fn , B2N7Ft , B2N7Fx , B2N7Fy , B2N7M , B2N7Mm , & - B2N7Phi , B2N7Re , B2N7SgCav , B2N7SigCr , B2N7STVx , B2N7STVy , B2N7STVz , & - B2N7Theta , B2N7TnInd , B2N7VDisx , B2N7VDisy , B2N7VDisz , B2N7Vindx , B2N7Vindy , & - B2N7VRel , B2N7VUndx , B2N7VUndy , B2N7VUndz , B2N8Alpha , B2N8AxInd , B2N8Cd , & - B2N8Cl , B2N8Clrnc , B2N8Cm , B2N8Cn , B2N8Cpmin , B2N8Ct , B2N8Curve , & - B2N8Cx , B2N8Cy , B2N8DynP , B2N8Fd , B2N8Fl , B2N8Fn , B2N8Ft , & - B2N8Fx , B2N8Fy , B2N8M , B2N8Mm , B2N8Phi , B2N8Re , B2N8SgCav , & - B2N8SigCr , B2N8STVx , B2N8STVy , B2N8STVz , B2N8Theta , B2N8TnInd , B2N8VDisx , & - B2N8VDisy , B2N8VDisz , B2N8Vindx , B2N8Vindy , B2N8VRel , B2N8VUndx , B2N8VUndy , & - B2N8VUndz , B2N9Alpha , B2N9AxInd , B2N9Cd , B2N9Cl , B2N9Clrnc , B2N9Cm , & - B2N9Cn , B2N9Cpmin , B2N9Ct , B2N9Curve , B2N9Cx , B2N9Cy , B2N9DynP , & - B2N9Fd , B2N9Fl , B2N9Fn , B2N9Ft , B2N9Fx , B2N9Fy , B2N9M , & - B2N9Mm , B2N9Phi , B2N9Re , B2N9SgCav , B2N9SigCr , B2N9STVx , B2N9STVy , & - B2N9STVz , B2N9Theta , B2N9TnInd , B2N9VDisx , B2N9VDisy , B2N9VDisz , B2N9Vindx , & - B2N9Vindy , B2N9VRel , B2N9VUndx , B2N9VUndy , B2N9VUndz , B2Pitch , B3Azimuth , & - B3N1Alpha , B3N1AxInd , B3N1Cd , B3N1Cl , B3N1Clrnc , B3N1Cm , B3N1Cn , & - B3N1Cpmin , B3N1Ct , B3N1Curve , B3N1Cx , B3N1Cy , B3N1DynP , B3N1Fd , & - B3N1Fl , B3N1Fn , B3N1Ft , B3N1Fx , B3N1Fy , B3N1M , B3N1Mm , & - B3N1Phi , B3N1Re , B3N1SgCav , B3N1SigCr , B3N1STVx , B3N1STVy , B3N1STVz , & - B3N1Theta , B3N1TnInd , B3N1VDisx , B3N1VDisy , B3N1VDisz , B3N1Vindx , B3N1Vindy , & - B3N1VRel , B3N1VUndx , B3N1VUndy , B3N1VUndz , B3N2Alpha , B3N2AxInd , B3N2Cd , & - B3N2Cl , B3N2Clrnc , B3N2Cm , B3N2Cn , B3N2Cpmin , B3N2Ct , B3N2Curve , & - B3N2Cx , B3N2Cy , B3N2DynP , B3N2Fd , B3N2Fl , B3N2Fn , B3N2Ft , & - B3N2Fx , B3N2Fy , B3N2M , B3N2Mm , B3N2Phi , B3N2Re , B3N2SgCav , & - B3N2SigCr , B3N2STVx , B3N2STVy , B3N2STVz , B3N2Theta , B3N2TnInd , B3N2VDisx , & - B3N2VDisy , B3N2VDisz , B3N2Vindx , B3N2Vindy , B3N2VRel , B3N2VUndx , B3N2VUndy , & - B3N2VUndz , B3N3Alpha , B3N3AxInd , B3N3Cd , B3N3Cl , B3N3Clrnc , B3N3Cm , & - B3N3Cn , B3N3Cpmin , B3N3Ct , B3N3Curve , B3N3Cx , B3N3Cy , B3N3DynP , & - B3N3Fd , B3N3Fl , B3N3Fn , B3N3Ft , B3N3Fx , B3N3Fy , B3N3M , & + B2N6Fy , B2N6Gam , B2N6M , B2N6Mm , B2N6Phi , B2N6Re , B2N6SgCav , & + B2N6SigCr , B2N6STVx , B2N6STVy , B2N6STVz , B2N6Theta , B2N6TnInd , B2N6VDisx , & + B2N6VDisy , B2N6VDisz , B2N6Vindx , B2N6Vindy , B2N6VRel , B2N6VUndx , B2N6VUndy , & + B2N6VUndz , B2N7Alpha , B2N7AxInd , B2N7Cd , B2N7Cl , B2N7Clrnc , B2N7Cm , & + B2N7Cn , B2N7Cpmin , B2N7Ct , B2N7Curve , B2N7Cx , B2N7Cy , B2N7DynP , & + B2N7Fd , B2N7Fl , B2N7Fn , B2N7Ft , B2N7Fx , B2N7Fy , B2N7Gam , & + B2N7M , B2N7Mm , B2N7Phi , B2N7Re , B2N7SgCav , B2N7SigCr , B2N7STVx , & + B2N7STVy , B2N7STVz , B2N7Theta , B2N7TnInd , B2N7VDisx , B2N7VDisy , B2N7VDisz , & + B2N7Vindx , B2N7Vindy , B2N7VRel , B2N7VUndx , B2N7VUndy , B2N7VUndz , B2N8Alpha , & + B2N8AxInd , B2N8Cd , B2N8Cl , B2N8Clrnc , B2N8Cm , B2N8Cn , B2N8Cpmin , & + B2N8Ct , B2N8Curve , B2N8Cx , B2N8Cy , B2N8DynP , B2N8Fd , B2N8Fl , & + B2N8Fn , B2N8Ft , B2N8Fx , B2N8Fy , B2N8Gam , B2N8M , B2N8Mm , & + B2N8Phi , B2N8Re , B2N8SgCav , B2N8SigCr , B2N8STVx , B2N8STVy , B2N8STVz , & + B2N8Theta , B2N8TnInd , B2N8VDisx , B2N8VDisy , B2N8VDisz , B2N8Vindx , B2N8Vindy , & + B2N8VRel , B2N8VUndx , B2N8VUndy , B2N8VUndz , B2N9Alpha , B2N9AxInd , B2N9Cd , & + B2N9Cl , B2N9Clrnc , B2N9Cm , B2N9Cn , B2N9Cpmin , B2N9Ct , B2N9Curve , & + B2N9Cx , B2N9Cy , B2N9DynP , B2N9Fd , B2N9Fl , B2N9Fn , B2N9Ft , & + B2N9Fx , B2N9Fy , B2N9Gam , B2N9M , B2N9Mm , B2N9Phi , B2N9Re , & + B2N9SgCav , B2N9SigCr , B2N9STVx , B2N9STVy , B2N9STVz , B2N9Theta , B2N9TnInd , & + B2N9VDisx , B2N9VDisy , B2N9VDisz , B2N9Vindx , B2N9Vindy , B2N9VRel , B2N9VUndx , & + B2N9VUndy , B2N9VUndz , B2Pitch , B3Azimuth , B3N1Alpha , B3N1AxInd , B3N1Cd , & + B3N1Cl , B3N1Clrnc , B3N1Cm , B3N1Cn , B3N1Cpmin , B3N1Ct , B3N1Curve , & + B3N1Cx , B3N1Cy , B3N1DynP , B3N1Fd , B3N1Fl , B3N1Fn , B3N1Ft , & + B3N1Fx , B3N1Fy , B3N1Gam , B3N1M , B3N1Mm , B3N1Phi , B3N1Re , & + B3N1SgCav , B3N1SigCr , B3N1STVx , B3N1STVy , B3N1STVz , B3N1Theta , B3N1TnInd , & + B3N1VDisx , B3N1VDisy , B3N1VDisz , B3N1Vindx , B3N1Vindy , B3N1VRel , B3N1VUndx , & + B3N1VUndy , B3N1VUndz , B3N2Alpha , B3N2AxInd , B3N2Cd , B3N2Cl , B3N2Clrnc , & + B3N2Cm , B3N2Cn , B3N2Cpmin , B3N2Ct , B3N2Curve , B3N2Cx , B3N2Cy , & + B3N2DynP , B3N2Fd , B3N2Fl , B3N2Fn , B3N2Ft , B3N2Fx , B3N2Fy , & + B3N2Gam , B3N2M , B3N2Mm , B3N2Phi , B3N2Re , B3N2SgCav , B3N2SigCr , & + B3N2STVx , B3N2STVy , B3N2STVz , B3N2Theta , B3N2TnInd , B3N2VDisx , B3N2VDisy , & + B3N2VDisz , B3N2Vindx , B3N2Vindy , B3N2VRel , B3N2VUndx , B3N2VUndy , B3N2VUndz , & + B3N3Alpha , B3N3AxInd , B3N3Cd , B3N3Cl , B3N3Clrnc , B3N3Cm , B3N3Cn , & + B3N3Cpmin , B3N3Ct , B3N3Curve , B3N3Cx , B3N3Cy , B3N3DynP , B3N3Fd , & + B3N3Fl , B3N3Fn , B3N3Ft , B3N3Fx , B3N3Fy , B3N3Gam , B3N3M , & B3N3Mm , B3N3Phi , B3N3Re , B3N3SgCav , B3N3SigCr , B3N3STVx , B3N3STVy , & B3N3STVz , B3N3Theta , B3N3TnInd , B3N3VDisx , B3N3VDisy , B3N3VDisz , B3N3Vindx , & B3N3Vindy , B3N3VRel , B3N3VUndx , B3N3VUndy , B3N3VUndz , B3N4Alpha , B3N4AxInd , & B3N4Cd , B3N4Cl , B3N4Clrnc , B3N4Cm , B3N4Cn , B3N4Cpmin , B3N4Ct , & B3N4Curve , B3N4Cx , B3N4Cy , B3N4DynP , B3N4Fd , B3N4Fl , B3N4Fn , & - B3N4Ft , B3N4Fx , B3N4Fy , B3N4M , B3N4Mm , B3N4Phi , B3N4Re , & - B3N4SgCav , B3N4SigCr , B3N4STVx , B3N4STVy , B3N4STVz , B3N4Theta , B3N4TnInd , & - B3N4VDisx , B3N4VDisy , B3N4VDisz , B3N4Vindx , B3N4Vindy , B3N4VRel , B3N4VUndx , & - B3N4VUndy , B3N4VUndz , B3N5Alpha , B3N5AxInd , B3N5Cd , B3N5Cl , B3N5Clrnc , & - B3N5Cm , B3N5Cn , B3N5Cpmin , B3N5Ct , B3N5Curve , B3N5Cx , B3N5Cy , & - B3N5DynP , B3N5Fd , B3N5Fl , B3N5Fn , B3N5Ft , B3N5Fx , B3N5Fy , & - B3N5M , B3N5Mm , B3N5Phi , B3N5Re , B3N5SgCav , B3N5SigCr , B3N5STVx , & - B3N5STVy , B3N5STVz , B3N5Theta , B3N5TnInd , B3N5VDisx , B3N5VDisy , B3N5VDisz , & - B3N5Vindx , B3N5Vindy , B3N5VRel , B3N5VUndx , B3N5VUndy , B3N5VUndz , B3N6Alpha , & - B3N6AxInd , B3N6Cd , B3N6Cl , B3N6Clrnc , B3N6Cm , B3N6Cn , B3N6Cpmin , & - B3N6Ct , B3N6Curve , B3N6Cx , B3N6Cy , B3N6DynP , B3N6Fd , B3N6Fl , & - B3N6Fn , B3N6Ft , B3N6Fx , B3N6Fy , B3N6M , B3N6Mm , B3N6Phi , & - B3N6Re , B3N6SgCav , B3N6SigCr , B3N6STVx , B3N6STVy , B3N6STVz , B3N6Theta , & - B3N6TnInd , B3N6VDisx , B3N6VDisy , B3N6VDisz , B3N6Vindx , B3N6Vindy , B3N6VRel , & - B3N6VUndx , B3N6VUndy , B3N6VUndz , B3N7Alpha , B3N7AxInd , B3N7Cd , B3N7Cl , & - B3N7Clrnc , B3N7Cm , B3N7Cn , B3N7Cpmin , B3N7Ct , B3N7Curve , B3N7Cx , & - B3N7Cy , B3N7DynP , B3N7Fd , B3N7Fl , B3N7Fn , B3N7Ft , B3N7Fx , & - B3N7Fy , B3N7M , B3N7Mm , B3N7Phi , B3N7Re , B3N7SgCav , B3N7SigCr , & - B3N7STVx , B3N7STVy , B3N7STVz , B3N7Theta , B3N7TnInd , B3N7VDisx , B3N7VDisy , & - B3N7VDisz , B3N7Vindx , B3N7Vindy , B3N7VRel , B3N7VUndx , B3N7VUndy , B3N7VUndz , & - B3N8Alpha , B3N8AxInd , B3N8Cd , B3N8Cl , B3N8Clrnc , B3N8Cm , B3N8Cn , & - B3N8Cpmin , B3N8Ct , B3N8Curve , B3N8Cx , B3N8Cy , B3N8DynP , B3N8Fd , & - B3N8Fl , B3N8Fn , B3N8Ft , B3N8Fx , B3N8Fy , B3N8M , B3N8Mm , & - B3N8Phi , B3N8Re , B3N8SgCav , B3N8SigCr , B3N8STVx , B3N8STVy , B3N8STVz , & - B3N8Theta , B3N8TnInd , B3N8VDisx , B3N8VDisy , B3N8VDisz , B3N8Vindx , B3N8Vindy , & - B3N8VRel , B3N8VUndx , B3N8VUndy , B3N8VUndz , B3N9Alpha , B3N9AxInd , B3N9Cd , & - B3N9Cl , B3N9Clrnc , B3N9Cm , B3N9Cn , B3N9Cpmin , B3N9Ct , B3N9Curve , & - B3N9Cx , B3N9Cy , B3N9DynP , B3N9Fd , B3N9Fl , B3N9Fn , B3N9Ft , & - B3N9Fx , B3N9Fy , B3N9M , B3N9Mm , B3N9Phi , B3N9Re , B3N9SgCav , & - B3N9SigCr , B3N9STVx , B3N9STVy , B3N9STVz , B3N9Theta , B3N9TnInd , B3N9VDisx , & - B3N9VDisy , B3N9VDisz , B3N9Vindx , B3N9Vindy , B3N9VRel , B3N9VUndx , B3N9VUndy , & - B3N9VUndz , B3Pitch , RtAeroCp , RtAeroCq , RtAeroCt , RtAeroFxh , RtAeroFyh , & - RtAeroFzh , RtAeroMxh , RtAeroMyh , RtAeroMzh , RtAeroPwr , RtArea , RtSkew , & - RtSpeed , RtTSR , RtVAvgxh , RtVAvgyh , RtVAvgzh , TwN1DynP , TwN1Fdx , & - TwN1Fdy , TwN1M , TwN1Re , TwN1STVx , TwN1STVy , TwN1STVz , TwN1Vrel , & - TwN1VUndx , TwN1VUndy , TwN1VUndz , TwN2DynP , TwN2Fdx , TwN2Fdy , TwN2M , & - TwN2Re , TwN2STVx , TwN2STVy , TwN2STVz , TwN2Vrel , TwN2VUndx , TwN2VUndy , & - TwN2VUndz , TwN3DynP , TwN3Fdx , TwN3Fdy , TwN3M , TwN3Re , TwN3STVx , & - TwN3STVy , TwN3STVz , TwN3Vrel , TwN3VUndx , TwN3VUndy , TwN3VUndz , TwN4DynP , & - TwN4Fdx , TwN4Fdy , TwN4M , TwN4Re , TwN4STVx , TwN4STVy , TwN4STVz , & - TwN4Vrel , TwN4VUndx , TwN4VUndy , TwN4VUndz , TwN5DynP , TwN5Fdx , TwN5Fdy , & - TwN5M , TwN5Re , TwN5STVx , TwN5STVy , TwN5STVz , TwN5Vrel , TwN5VUndx , & - TwN5VUndy , TwN5VUndz , TwN6DynP , TwN6Fdx , TwN6Fdy , TwN6M , TwN6Re , & - TwN6STVx , TwN6STVy , TwN6STVz , TwN6Vrel , TwN6VUndx , TwN6VUndy , TwN6VUndz , & - TwN7DynP , TwN7Fdx , TwN7Fdy , TwN7M , TwN7Re , TwN7STVx , TwN7STVy , & - TwN7STVz , TwN7Vrel , TwN7VUndx , TwN7VUndy , TwN7VUndz , TwN8DynP , TwN8Fdx , & - 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(1184) = (/ & ! This lists the units corresponding to the allowed parameters + B3N4Ft , B3N4Fx , B3N4Fy , B3N4Gam , B3N4M , B3N4Mm , B3N4Phi , & + B3N4Re , B3N4SgCav , B3N4SigCr , B3N4STVx , B3N4STVy , B3N4STVz , B3N4Theta , & + B3N4TnInd , B3N4VDisx , B3N4VDisy , B3N4VDisz , B3N4Vindx , B3N4Vindy , B3N4VRel , & + B3N4VUndx , B3N4VUndy , B3N4VUndz , B3N5Alpha , B3N5AxInd , B3N5Cd , B3N5Cl , & + B3N5Clrnc , B3N5Cm , B3N5Cn , B3N5Cpmin , B3N5Ct , B3N5Curve , B3N5Cx , & + B3N5Cy , B3N5DynP , B3N5Fd , B3N5Fl , B3N5Fn , B3N5Ft , B3N5Fx , & + B3N5Fy , B3N5Gam , B3N5M , B3N5Mm , B3N5Phi , B3N5Re , B3N5SgCav , & + B3N5SigCr , B3N5STVx , B3N5STVy , B3N5STVz , B3N5Theta , B3N5TnInd , B3N5VDisx , & + B3N5VDisy , B3N5VDisz , B3N5Vindx , B3N5Vindy , B3N5VRel , B3N5VUndx , B3N5VUndy , & + B3N5VUndz , B3N6Alpha , B3N6AxInd , B3N6Cd , B3N6Cl , B3N6Clrnc , B3N6Cm , & + B3N6Cn , B3N6Cpmin , B3N6Ct , B3N6Curve , B3N6Cx , B3N6Cy , B3N6DynP , & + B3N6Fd , B3N6Fl , B3N6Fn , B3N6Ft , B3N6Fx , B3N6Fy , B3N6Gam , & + B3N6M , B3N6Mm , B3N6Phi , B3N6Re , B3N6SgCav , B3N6SigCr , B3N6STVx , & + B3N6STVy , B3N6STVz , B3N6Theta , B3N6TnInd , B3N6VDisx , B3N6VDisy , B3N6VDisz , & + B3N6Vindx , B3N6Vindy , B3N6VRel , B3N6VUndx , B3N6VUndy , B3N6VUndz , B3N7Alpha , & + B3N7AxInd , B3N7Cd , B3N7Cl , B3N7Clrnc , B3N7Cm , B3N7Cn , B3N7Cpmin , & + B3N7Ct , B3N7Curve , B3N7Cx , B3N7Cy , B3N7DynP , B3N7Fd , B3N7Fl , & + B3N7Fn , B3N7Ft , B3N7Fx , B3N7Fy , B3N7Gam , B3N7M , B3N7Mm , & + B3N7Phi , B3N7Re , B3N7SgCav , B3N7SigCr , B3N7STVx , B3N7STVy , B3N7STVz , & + B3N7Theta , B3N7TnInd , B3N7VDisx , B3N7VDisy , B3N7VDisz , B3N7Vindx , B3N7Vindy , & + B3N7VRel , B3N7VUndx , B3N7VUndy , B3N7VUndz , B3N8Alpha , B3N8AxInd , B3N8Cd , & + B3N8Cl , B3N8Clrnc , B3N8Cm , B3N8Cn , B3N8Cpmin , B3N8Ct , B3N8Curve , & + B3N8Cx , B3N8Cy , B3N8DynP , B3N8Fd , B3N8Fl , B3N8Fn , B3N8Ft , & + B3N8Fx , B3N8Fy , B3N8Gam , B3N8M , B3N8Mm , B3N8Phi , B3N8Re , & + B3N8SgCav , B3N8SigCr , B3N8STVx , B3N8STVy , B3N8STVz , B3N8Theta , B3N8TnInd , & + B3N8VDisx , B3N8VDisy , B3N8VDisz , B3N8Vindx , B3N8Vindy , B3N8VRel , B3N8VUndx , & + B3N8VUndy , B3N8VUndz , B3N9Alpha , B3N9AxInd , B3N9Cd , B3N9Cl , B3N9Clrnc , & + B3N9Cm , B3N9Cn , B3N9Cpmin , B3N9Ct , B3N9Curve , B3N9Cx , B3N9Cy , & + B3N9DynP , B3N9Fd , B3N9Fl , B3N9Fn , B3N9Ft , B3N9Fx , B3N9Fy , & + B3N9Gam , B3N9M , B3N9Mm , B3N9Phi , B3N9Re , B3N9SgCav , B3N9SigCr , & + B3N9STVx , B3N9STVy , B3N9STVz , B3N9Theta , B3N9TnInd , B3N9VDisx , B3N9VDisy , & + B3N9VDisz , B3N9Vindx , B3N9Vindy , B3N9VRel , B3N9VUndx , B3N9VUndy , B3N9VUndz , & + B3Pitch , RtAeroCp , RtAeroCq , RtAeroCt , RtAeroFxh , RtAeroFyh , RtAeroFzh , & + RtAeroMxh , RtAeroMyh , RtAeroMzh , RtAeroPwr , RtArea , RtSkew , RtSpeed , & + RtTSR , RtVAvgxh , RtVAvgyh , RtVAvgzh , TwN1DynP , TwN1Fdx , TwN1Fdy , & + TwN1M , TwN1Re , TwN1STVx , TwN1STVy , TwN1STVz , TwN1Vrel , TwN1VUndx , & + TwN1VUndy , TwN1VUndz , TwN2DynP , TwN2Fdx , TwN2Fdy , TwN2M , TwN2Re , & + TwN2STVx , TwN2STVy , TwN2STVz , TwN2Vrel , TwN2VUndx , TwN2VUndy , TwN2VUndz , & + TwN3DynP , TwN3Fdx , TwN3Fdy , TwN3M , TwN3Re , TwN3STVx , TwN3STVy , & + TwN3STVz , TwN3Vrel , TwN3VUndx , TwN3VUndy , TwN3VUndz , TwN4DynP , TwN4Fdx , & + TwN4Fdy , TwN4M , TwN4Re , TwN4STVx , TwN4STVy , TwN4STVz , TwN4Vrel , & + TwN4VUndx , TwN4VUndy , TwN4VUndz , TwN5DynP , TwN5Fdx , TwN5Fdy , TwN5M , & + TwN5Re , TwN5STVx , TwN5STVy , TwN5STVz , TwN5Vrel , TwN5VUndx , TwN5VUndy , & + TwN5VUndz , TwN6DynP , TwN6Fdx , TwN6Fdy , TwN6M , TwN6Re , TwN6STVx , & + TwN6STVy , TwN6STVz , TwN6Vrel , TwN6VUndx , TwN6VUndy , TwN6VUndz , TwN7DynP , & + TwN7Fdx , TwN7Fdy , TwN7M , TwN7Re , TwN7STVx , TwN7STVy , TwN7STVz , & + TwN7Vrel , TwN7VUndx , TwN7VUndy , TwN7VUndz , TwN8DynP , TwN8Fdx , 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(1211) = (/ & ! This lists the units corresponding to the allowed parameters "(deg) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ", & - "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ", & "(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ", & - "(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ", & "(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & "(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & + "(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ", & + "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & + "(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & + "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ", & "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ", & "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ", & - "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(deg) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & + "(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ", & + "(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & + "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & + "(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & + "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ", & - "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ", & "(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ", & - "(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ", & + "(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & + "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(deg) ","(deg) ", & + "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & + "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ", & "(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & "(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & + "(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ", & + "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & + "(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & + "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ", & + "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & + "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ", & + "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ", & + "(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & + "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & + "(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & + "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(deg) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ", & + "(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & + "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & + "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ", & "(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & "(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & + "(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ", & + "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ", & + "(m/s) ","(m/s) ","(deg) ","(deg) ","(deg) ","(-) ","(-) ", & + "(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & + "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ", & "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & "(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ", & + "(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & + "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ", & + "(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & + "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(-) ", & + "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ", & "(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & "(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & + "(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & + "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m) ", & + "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & + "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ", & + "(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & + "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & + "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ", & "(deg) ","(-) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & "(-) ","(m) ","(-) ","(-) ","(-) ","(-) ","(deg) ", & "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & + "(N/m) ","(N/m) ","(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ", & + "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & + "(-) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(m^2/s) ","(-) ","(N-m/m) ","(deg) ","(-) ","(-) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(deg) ","(-) ","(-) ","(-) ","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(W) ","(m^2) ","(deg) ","(rpm) ", & + "(-) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ", & + "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(W) ","(m^2) ","(deg) ", & - "(rpm) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ", & + "(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ", & "(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ", & "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & @@ -3303,13 +3545,7 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ", & "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ", & - "(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) "/) + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) "/) ! Initialize values @@ -3387,6 +3623,10 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( BNFn( :,i) ) = .true. InvalidOutput( BNFt( :,i) ) = .true. InvalidOutput( BNClrnc(:,i) ) = .true. + InvalidOutput( BNGam( :,i) ) = .true. + InvalidOutput( BNSgCav(:,i) ) = .true. + InvalidOutput( BNSigCr(:,i) ) = .true. + InvalidOutput( BNCpMin(:,i) ) = .true. END DO @@ -3428,6 +3668,10 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( BNFn( i,:) ) = .true. InvalidOutput( BNFt( i,:) ) = .true. InvalidOutput( BNClrnc(i,:) ) = .true. + InvalidOutput( BNGam( i,:) ) = .true. + InvalidOutput( BNSgCav(i,:) ) = .true. + InvalidOutput( BNSigCr(i,:) ) = .true. + InvalidOutput( BNCpMin(i,:) ) = .true. END DO diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index fed1af801e..3d4b03171b 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -13,7 +13,21 @@ include Registry_NWTC_Library.txt usefrom AirfoilInfo_Registry.txt usefrom BEMT_Registry.txt +usefrom FVW_Registry.txt usefrom UnsteadyAero_Registry.txt +usefrom AeroAcoustics_Registry.txt + +param AeroDyn/AD - IntKi ModelUnknown - -1 - "" - +param ^ - IntKi WakeMod_none - 0 - "Wake model - none" - +param ^ - IntKi WakeMod_BEMT - 1 - "Wake model - BEMT (blade elememnt momentum theory)" - +param ^ - IntKi WakeMod_DBEMT - 2 - "Wake model - DBEMT (dynamic elememnt momentum theory)" - +param ^ - IntKi WakeMod_FVW - 3 - "Wake model - FVW (free vortex wake, OLAF)" - +param ^ - IntKi AFAeroMod_steady - 1 - "steady model" - +param ^ - IntKi AFAeroMod_BL_unsteady - 2 - "Beddoes-Leishman unsteady model" - +param ^ - IntKi TwrPotent_none - 0 - "no tower potential flow" - +param ^ - IntKi TwrPotent_baseline - 1 - "baseline tower potential flow" - +param ^ - IntKi TwrPotent_Bak - 2 - "tower potential flow with Bak correction" - + # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: @@ -61,13 +75,15 @@ typedef ^ InitOutputType ReKi TwrDiam {:} - - "Diameter of tower at node" m # ..... Primary Input file data ................................................................................................... typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or "default"}" s -typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT}" - +typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - typedef ^ AD_InputFile IntKi AFAeroMod - - - "Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model}" - typedef ^ AD_InputFile IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - typedef ^ AD_InputFile LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - typedef ^ AD_InputFile Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - +typedef ^ AD_InputFile Logical CompAA - - - "Compute AeroAcoustic noise" flag +typedef ^ AD_InputFile CHARACTER(1024) AA_InputFile - - - "AeroAcoustics input file name" "quoted strings" typedef ^ AD_InputFile ReKi AirDens - - - "Air density" kg/m^3 typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ AD_InputFile ReKi Patm - - - "Atmospheric pressure" Pa @@ -83,7 +99,7 @@ typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial- typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE]" flag typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [unused when WakeMod=0]" - typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [unused when WakeMod=0]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - +typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2]" flag typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - @@ -92,6 +108,7 @@ typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables tha typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - typedef ^ AD_InputFile INTEGER AFTabMod - - - "Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp}" - typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - +typedef ^ AD_InputFile CHARACTER(1024) FVWFileName - - - "FVW input filename" "quoted string" typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" typedef ^ AD_InputFile LOGICAL UseBlCm - - - "Include aerodynamic pitching moment in calculations?" flag #typedef ^ AD_InputFile IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - @@ -109,24 +126,46 @@ typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output l typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - typedef ^ AD_InputFile ReKi tau1_const - - - "time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1]" s typedef ^ AD_InputFile IntKi DBEMT_Mod - - - "Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1}" - +typedef ^ AD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (AD_AllBldNdOuts)" - +#typedef ^ AD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - +#typedef ^ AD_InputFile CHARACTER(1024) BldNd_BladesOut_Str - - - "String to parse for the he blades to output (AD_AllBldNdOuts)" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: typedef ^ ContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - +typedef ^ ContinuousStateType FVW_ContinuousStateType FVW - - - "Continuous states from the FVW module" - +typedef ^ ContinuousStateType AA_ContinuousStateType AA - - - "Continuous states from the AA module" - # Define discrete (nondifferentiable) states here: typedef ^ DiscreteStateType BEMT_DiscreteStateType BEMT - - - "Discrete states from the BEMT module" - +typedef ^ DiscreteStateType FVW_DiscreteStateType FVW - - - "Discrete states from the FVW module" - +typedef ^ DiscreteStateType AA_DiscreteStateType AA - - - "Discrete states from the AA module" - # Define constraint states here: typedef ^ ConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - +typedef ^ ConstraintStateType FVW_ConstraintStateType FVW - - - "Constraint states from the FVW module" - +typedef ^ ConstraintStateType AA_ConstraintStateType AA - - - "Constraint states from the AA module" - # Define "other" states here: typedef ^ OtherStateType BEMT_OtherStateType BEMT - - - "OtherStates from the BEMT module" - +typedef ^ OtherStateType FVW_OtherStateType FVW - - - "OtherStates from the FVW module" - +typedef ^ OtherStateType ReKi WakeLocationPoints {:}{:} - - "wake points velocity" m/s +typedef ^ OtherStateType AA_OtherStateType AA - - - "OtherStates from the AA module" - # Define misc/optimization variables (any data that are not considered actual states) here: typedef ^ MiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - typedef ^ MiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - typedef ^ MiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - +typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - +typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - +typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - +typedef ^ MiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - +typedef ^ MiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - +typedef ^ MiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - + typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s typedef ^ MiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - @@ -151,12 +190,13 @@ typedef ^ MiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issu # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT}" - +typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - typedef ^ ParameterType IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - typedef ^ ParameterType LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - typedef ^ ParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag typedef ^ ParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - typedef ^ ParameterType Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - +typedef ^ ParameterType Logical CompAA - - - "Compute AeroAcoustic noise" flag typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - typedef ^ ParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - @@ -171,6 +211,8 @@ typedef ^ ParameterType ReKi Pvap - - - "Vapour pressure" Pa typedef ^ ParameterType ReKi FluidDepth - - - "Submerged hub height" m typedef ^ ParameterType AFI_ParameterType AFI {:} - - "AirfoilInfo parameters" typedef ^ ParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" +typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" +typedef ^ ParameterType AA_ParameterType AA - - - "Parameters for AA module" # parameters for output typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - @@ -179,6 +221,14 @@ typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9 typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - + +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - + + typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - @@ -193,6 +243,7 @@ typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - typedef ^ InputType ReKi InflowOnBlade {:}{:}{:} - - "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s typedef ^ InputType ReKi InflowOnTower {:}{:} - - "U,V,W at nodes on the tower" m/s typedef ^ InputType ReKi UserProp {:}{:} - - "Optional user property for interpolating airfoils (per element per blade)" - +typedef ^ InputType ReKi InflowWakeVel {:}{:} - - "U,V,W at wake points" m/s # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 223b9724fc..a080196219 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -35,8 +35,20 @@ MODULE AeroDyn_Types USE UnsteadyAero_Types USE DBEMT_Types USE BEMT_Types +USE FVW_Types +USE AeroAcoustics_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_none = 0 ! Wake model - none [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_BEMT = 1 ! Wake model - BEMT (blade elememnt momentum theory) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_DBEMT = 2 ! Wake model - DBEMT (dynamic elememnt momentum theory) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_FVW = 3 ! Wake model - FVW (free vortex wake, OLAF) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_steady = 1 ! steady model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_none = 0 ! no tower potential flow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_baseline = 1 ! baseline tower potential flow [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_Bak = 2 ! tower potential flow with Bak correction [-] ! ========= AD_InitInputType ======= TYPE, PUBLIC :: AD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] @@ -89,13 +101,15 @@ MODULE AeroDyn_Types ! ========= AD_InputFile ======= TYPE, PUBLIC :: AD_InputFile REAL(DbKi) :: DTAero !< Time interval for aerodynamic calculations {or "default"} [s] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT} [-] + INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] INTEGER(IntKi) :: AFAeroMod !< Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} [-] INTEGER(IntKi) :: TwrPotent !< Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] LOGICAL :: TwrShadow !< Calculate tower influence on wind based on downstream tower shadow? [-] LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] + CHARACTER(1024) :: AA_InputFile !< AeroAcoustics input file name [quoted strings] REAL(ReKi) :: AirDens !< Air density [kg/m^3] REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] @@ -111,7 +125,7 @@ MODULE AeroDyn_Types LOGICAL :: TIDrag !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] REAL(ReKi) :: IndToler !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] REAL(ReKi) :: MaxIter !< Maximum number of iteration steps [unused when WakeMod=0] [-] - INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] + INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] LOGICAL :: FLookup !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] REAL(ReKi) :: InCol_Alfa !< The column in the airfoil tables that contains the angle of attack [-] REAL(ReKi) :: InCol_Cl !< The column in the airfoil tables that contains the lift coefficient [-] @@ -120,6 +134,7 @@ MODULE AeroDyn_Types REAL(ReKi) :: InCol_Cpmin !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] INTEGER(IntKi) :: NumAFfiles !< Number of airfoil files used [-] + CHARACTER(1024) :: FVWFileName !< FVW input filename [quoted string] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AFNames !< Airfoil file names (NumAF lines) [quoted strings] LOGICAL :: UseBlCm !< Include aerodynamic pitching moment in calculations? [flag] TYPE(AD_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] @@ -136,26 +151,39 @@ MODULE AeroDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] REAL(ReKi) :: tau1_const !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1] [s] INTEGER(IntKi) :: DBEMT_Mod !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (AD_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] END TYPE AD_InputFile ! ======================= ! ========= AD_ContinuousStateType ======= TYPE, PUBLIC :: AD_ContinuousStateType TYPE(BEMT_ContinuousStateType) :: BEMT !< Continuous states from the BEMT module [-] + TYPE(FVW_ContinuousStateType) :: FVW !< Continuous states from the FVW module [-] + TYPE(AA_ContinuousStateType) :: AA !< Continuous states from the AA module [-] END TYPE AD_ContinuousStateType ! ======================= ! ========= AD_DiscreteStateType ======= TYPE, PUBLIC :: AD_DiscreteStateType TYPE(BEMT_DiscreteStateType) :: BEMT !< Discrete states from the BEMT module [-] + TYPE(FVW_DiscreteStateType) :: FVW !< Discrete states from the FVW module [-] + TYPE(AA_DiscreteStateType) :: AA !< Discrete states from the AA module [-] END TYPE AD_DiscreteStateType ! ======================= ! ========= AD_ConstraintStateType ======= TYPE, PUBLIC :: AD_ConstraintStateType TYPE(BEMT_ConstraintStateType) :: BEMT !< Constraint states from the BEMT module [-] + TYPE(FVW_ConstraintStateType) :: FVW !< Constraint states from the FVW module [-] + TYPE(AA_ConstraintStateType) :: AA !< Constraint states from the AA module [-] END TYPE AD_ConstraintStateType ! ======================= ! ========= AD_OtherStateType ======= TYPE, PUBLIC :: AD_OtherStateType TYPE(BEMT_OtherStateType) :: BEMT !< OtherStates from the BEMT module [-] + TYPE(FVW_OtherStateType) :: FVW !< OtherStates from the FVW module [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WakeLocationPoints !< wake points velocity [m/s] + TYPE(AA_OtherStateType) :: AA !< OtherStates from the AA module [-] END TYPE AD_OtherStateType ! ======================= ! ========= AD_MiscVarType ======= @@ -163,6 +191,12 @@ MODULE AeroDyn_Types TYPE(BEMT_MiscVarType) :: BEMT !< MiscVars from the BEMT module [-] TYPE(BEMT_OutputType) :: BEMT_y !< Outputs from the BEMT module [-] TYPE(BEMT_InputType) , DIMENSION(1:2) :: BEMT_u !< Inputs to the BEMT module [-] + TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] + TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] + TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] + TYPE(AA_MiscVarType) :: AA !< MiscVars from the AA module [-] + TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] + TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WithoutSweepPitchTwist !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] @@ -187,12 +221,13 @@ MODULE AeroDyn_Types ! ========= AD_ParameterType ======= TYPE, PUBLIC :: AD_ParameterType REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT} [-] + INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] INTEGER(IntKi) :: TwrPotent !< Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] LOGICAL :: TwrShadow !< Calculate tower influence on wind based on downstream tower shadow? [-] LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] INTEGER(IntKi) :: NumTwrNds !< Number of nodes on the tower [-] @@ -207,6 +242,8 @@ MODULE AeroDyn_Types REAL(ReKi) :: FluidDepth !< Submerged hub height [m] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFI !< AirfoilInfo parameters [-] TYPE(BEMT_ParameterType) :: BEMT !< Parameters for BEMT module [-] + TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] + TYPE(AA_ParameterType) :: AA !< Parameters for AA module [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] @@ -214,6 +251,11 @@ MODULE AeroDyn_Types INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] @@ -228,6 +270,7 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: InflowOnBlade !< U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowOnTower !< U,V,W at nodes on the tower [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowWakeVel !< U,V,W at wake points [m/s] END TYPE AD_InputType ! ======================= ! ========= AD_OutputType ======= @@ -391,24 +434,30 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPosition))-1 ) = PACK(InData%HubPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPosition) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%HubOrientation))-1 ) = PACK(InData%HubOrientation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%HubOrientation) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) + DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) + DbKiBuf(Db_Xferred) = InData%HubOrientation(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%BladeRootPosition) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -422,8 +471,12 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BladeRootPosition)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BladeRootPosition))-1 ) = PACK(InData%BladeRootPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BladeRootPosition) + DO i2 = LBOUND(InData%BladeRootPosition,2), UBOUND(InData%BladeRootPosition,2) + DO i1 = LBOUND(InData%BladeRootPosition,1), UBOUND(InData%BladeRootPosition,1) + ReKiBuf(Re_Xferred) = InData%BladeRootPosition(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeRootOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -441,8 +494,14 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BladeRootOrientation)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BladeRootOrientation))-1 ) = PACK(InData%BladeRootOrientation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BladeRootOrientation) + DO i3 = LBOUND(InData%BladeRootOrientation,3), UBOUND(InData%BladeRootOrientation,3) + DO i2 = LBOUND(InData%BladeRootOrientation,2), UBOUND(InData%BladeRootOrientation,2) + DO i1 = LBOUND(InData%BladeRootOrientation,1), UBOUND(InData%BladeRootOrientation,1) + DbKiBuf(Db_Xferred) = InData%BladeRootOrientation(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_PackInitInput @@ -459,12 +518,6 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -482,44 +535,36 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%HubPosition,1) i1_u = UBOUND(OutData%HubPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubOrientation,1) i1_u = UBOUND(OutData%HubOrientation,1) i2_l = LBOUND(OutData%HubOrientation,2) i2_u = UBOUND(OutData%HubOrientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HubOrientation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%HubOrientation))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%HubOrientation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) + DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) + OutData%HubOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootPosition not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -536,15 +581,12 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BladeRootPosition)>0) OutData%BladeRootPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BladeRootPosition))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BladeRootPosition) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BladeRootPosition,2), UBOUND(OutData%BladeRootPosition,2) + DO i1 = LBOUND(OutData%BladeRootPosition,1), UBOUND(OutData%BladeRootPosition,1) + OutData%BladeRootPosition(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -565,15 +607,14 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%BladeRootOrientation)>0) OutData%BladeRootOrientation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BladeRootOrientation))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BladeRootOrientation) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%BladeRootOrientation,3), UBOUND(OutData%BladeRootOrientation,3) + DO i2 = LBOUND(OutData%BladeRootOrientation,2), UBOUND(OutData%BladeRootOrientation,2) + DO i1 = LBOUND(OutData%BladeRootOrientation,1), UBOUND(OutData%BladeRootOrientation,1) + OutData%BladeRootOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_UnPackInitInput @@ -809,8 +850,8 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -821,8 +862,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlSpn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSpn))-1 ) = PACK(InData%BlSpn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSpn) + DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) + ReKiBuf(Re_Xferred) = InData%BlSpn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlCrvAC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -834,8 +877,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlCrvAC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlCrvAC))-1 ) = PACK(InData%BlCrvAC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlCrvAC) + DO i1 = LBOUND(InData%BlCrvAC,1), UBOUND(InData%BlCrvAC,1) + ReKiBuf(Re_Xferred) = InData%BlCrvAC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlSwpAC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -847,8 +892,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSwpAC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlSwpAC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSwpAC))-1 ) = PACK(InData%BlSwpAC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSwpAC) + DO i1 = LBOUND(InData%BlSwpAC,1), UBOUND(InData%BlSwpAC,1) + ReKiBuf(Re_Xferred) = InData%BlSwpAC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlCrvAng) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -860,8 +907,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAng,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlCrvAng)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlCrvAng))-1 ) = PACK(InData%BlCrvAng,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlCrvAng) + DO i1 = LBOUND(InData%BlCrvAng,1), UBOUND(InData%BlCrvAng,1) + ReKiBuf(Re_Xferred) = InData%BlCrvAng(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -873,8 +922,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlTwist))-1 ) = PACK(InData%BlTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlTwist) + DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) + ReKiBuf(Re_Xferred) = InData%BlTwist(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -886,8 +937,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlChord))-1 ) = PACK(InData%BlChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlChord) + DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) + ReKiBuf(Re_Xferred) = InData%BlChord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -899,8 +952,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlAFID)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlAFID))-1 ) = PACK(InData%BlAFID,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlAFID) + DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) + IntKiBuf(Int_Xferred) = InData%BlAFID(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackBladePropsType @@ -917,12 +972,6 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -937,8 +986,8 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -952,15 +1001,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlSpn)>0) OutData%BlSpn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSpn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSpn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) + OutData%BlSpn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAC not allocated Int_Xferred = Int_Xferred + 1 @@ -975,15 +1019,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlCrvAC)>0) OutData%BlCrvAC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlCrvAC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlCrvAC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlCrvAC,1), UBOUND(OutData%BlCrvAC,1) + OutData%BlCrvAC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSwpAC not allocated Int_Xferred = Int_Xferred + 1 @@ -998,15 +1037,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlSwpAC)>0) OutData%BlSwpAC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSwpAC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSwpAC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlSwpAC,1), UBOUND(OutData%BlSwpAC,1) + OutData%BlSwpAC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAng not allocated Int_Xferred = Int_Xferred + 1 @@ -1021,15 +1055,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlCrvAng)>0) OutData%BlCrvAng = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlCrvAng))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlCrvAng) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlCrvAng,1), UBOUND(OutData%BlCrvAng,1) + OutData%BlCrvAng(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated Int_Xferred = Int_Xferred + 1 @@ -1044,15 +1073,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlTwist)>0) OutData%BlTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlTwist))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlTwist) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) + OutData%BlTwist(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated Int_Xferred = Int_Xferred + 1 @@ -1067,15 +1091,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlChord)>0) OutData%BlChord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlChord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlChord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) + OutData%BlChord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated Int_Xferred = Int_Xferred + 1 @@ -1090,15 +1109,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlAFID)>0) OutData%BlAFID = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlAFID))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlAFID) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) + OutData%BlAFID(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackBladePropsType @@ -1234,8 +1248,14 @@ SUBROUTINE AD_PackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AirfoilCoords)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AirfoilCoords))-1 ) = PACK(InData%AirfoilCoords,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AirfoilCoords) + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_PackBladeShape @@ -1252,12 +1272,6 @@ SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1293,15 +1307,14 @@ SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AirfoilCoords)>0) OutData%AirfoilCoords = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AirfoilCoords))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%AirfoilCoords) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_UnPackBladeShape @@ -1739,12 +1752,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1756,12 +1769,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1791,8 +1804,8 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1844,12 +1857,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1861,12 +1874,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_z,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_z,1), UBOUND(InData%LinNames_z,1) + DO i1 = LBOUND(InData%LinNames_z,1), UBOUND(InData%LinNames_z,1) DO I = 1, LEN(InData%LinNames_z) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1878,12 +1891,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1895,8 +1908,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + 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_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1908,8 +1923,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_z)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_z)-1 ) = TRANSFER(PACK( InData%RotFrame_z ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_z)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_z) + DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1921,8 +1938,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1934,8 +1953,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1988,8 +2009,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrElev))-1 ) = PACK(InData%TwrElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrElev) + DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) + ReKiBuf(Re_Xferred) = InData%TwrElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2001,8 +2024,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackInitOutput @@ -2019,12 +2044,6 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2052,19 +2071,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2079,19 +2091,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2133,8 +2138,8 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2204,19 +2209,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_z not allocated Int_Xferred = Int_Xferred + 1 @@ -2231,19 +2229,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_z,1), UBOUND(OutData%LinNames_z,1) + DO i1 = LBOUND(OutData%LinNames_z,1), UBOUND(OutData%LinNames_z,1) DO I = 1, LEN(OutData%LinNames_z) OutData%LinNames_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2258,19 +2249,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -2285,15 +2269,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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_z not allocated Int_Xferred = Int_Xferred + 1 @@ -2308,15 +2287,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_z)>0) OutData%RotFrame_z = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_z))-1 ), OutData%RotFrame_z), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) + OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2331,15 +2305,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -2354,15 +2323,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2397,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrElev)>0) OutData%TwrElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) + OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 @@ -2456,15 +2415,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackInitOutput @@ -2491,6 +2445,8 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%TwrAero = SrcInputFileData%TwrAero DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck + DstInputFileData%CompAA = SrcInputFileData%CompAA + DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile DstInputFileData%AirDens = SrcInputFileData%AirDens DstInputFileData%KinVisc = SrcInputFileData%KinVisc DstInputFileData%Patm = SrcInputFileData%Patm @@ -2515,6 +2471,7 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles + DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName IF (ALLOCATED(SrcInputFileData%AFNames)) THEN i1_l = LBOUND(SrcInputFileData%AFNames,1) i1_u = UBOUND(SrcInputFileData%AFNames,1) @@ -2601,6 +2558,21 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF DstInputFileData%tau1_const = SrcInputFileData%tau1_const DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE AD_CopyInputFile SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -2632,6 +2604,9 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) ENDIF END SUBROUTINE AD_DestroyInputFile @@ -2678,6 +2653,8 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 1 ! TwrAero Int_BufSz = Int_BufSz + 1 ! FrozenWake Int_BufSz = Int_BufSz + 1 ! CavitCheck + Int_BufSz = Int_BufSz + 1 ! CompAA + Int_BufSz = Int_BufSz + 1*LEN(InData%AA_InputFile) ! AA_InputFile Re_BufSz = Re_BufSz + 1 ! AirDens Re_BufSz = Re_BufSz + 1 ! KinVisc Re_BufSz = Re_BufSz + 1 ! Patm @@ -2702,6 +2679,7 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + 1 ! InCol_Cpmin Int_BufSz = Int_BufSz + 1 ! AFTabMod Int_BufSz = Int_BufSz + 1 ! NumAFfiles + Int_BufSz = Int_BufSz + 1*LEN(InData%FVWFileName) ! FVWFileName Int_BufSz = Int_BufSz + 1 ! AFNames allocated yes/no IF ( ALLOCATED(InData%AFNames) ) THEN Int_BufSz = Int_BufSz + 2*1 ! AFNames upper/lower bounds for each dimension @@ -2761,6 +2739,14 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Re_BufSz = Re_BufSz + 1 ! tau1_const Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2788,70 +2774,80 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFAeroMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CavitCheck , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FluidDepth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SkewModFactor - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IndToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MaxIter - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FLookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Alfa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cpmin - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumAFfiles - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTAero + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFAeroMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrPotent + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%AA_InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AA_InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FluidDepth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SkewMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SkewModFactor + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IndToler + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MaxIter + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FLookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Alfa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cpmin + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumAFfiles + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%FVWFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%AFNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2862,15 +2858,15 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) + DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) DO I = 1, LEN(InData%AFNames) IntKiBuf(Int_Xferred) = ICHAR(InData%AFNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseBlCm , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBlCm, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2912,8 +2908,8 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2924,8 +2920,10 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrElev))-1 ) = PACK(InData%TwrElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrElev) + DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) + ReKiBuf(Re_Xferred) = InData%TwrElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2937,8 +2935,10 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2950,21 +2950,27 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCd))-1 ) = PACK(InData%TwrCd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCd) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlOutNd))-1 ) = PACK(InData%BlOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwOutNd))-1 ) = PACK(InData%TwOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) + ReKiBuf(Re_Xferred) = InData%TwrCd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NTwOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) + IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2975,17 +2981,42 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackInputFile SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3001,12 +3032,6 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3021,70 +3046,80 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DTAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AFAeroMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FluidDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SkewMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SkewModFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%HubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%IndToler = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FLookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cpmin = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumAFfiles = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DTAero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AFAeroMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) + Int_Xferred = Int_Xferred + 1 + OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) + Int_Xferred = Int_Xferred + 1 + OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%AA_InputFile) + OutData%AA_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FluidDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SkewMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SkewModFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%HubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%TanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%TanInd) + Int_Xferred = Int_Xferred + 1 + OutData%AIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%AIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%TIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%TIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%IndToler = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FLookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%FLookup) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Alfa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cpmin = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumAFfiles = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FVWFileName) + OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3098,22 +3133,15 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) + DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) DO I = 1, LEN(OutData%AFNames) OutData%AFNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%UseBlCm = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UseBlCm = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBlCm) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3170,8 +3198,8 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumTwrNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3185,15 +3213,10 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrElev)>0) OutData%TwrElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) + OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 @@ -3208,15 +3231,10 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated Int_Xferred = Int_Xferred + 1 @@ -3231,46 +3249,31 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrCd)>0) OutData%TwrCd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCd) - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NBlOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) + OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NBlOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlOutNd,1) i1_u = UBOUND(OutData%BlOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlOutNd) - DEALLOCATE(mask1) - OutData%NTwOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) + OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NTwOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwOutNd,1) i1_u = UBOUND(OutData%TwOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwOutNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) + OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3284,24 +3287,45 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackInputFile SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3321,6 +3345,12 @@ SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt CALL BEMT_CopyContState( SrcContStateData%BEMT, DstContStateData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyContState( SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AA_CopyContState( SrcContStateData%AA, DstContStateData%AA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyContState SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) @@ -3333,6 +3363,8 @@ SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" CALL BEMT_DestroyContState( ContStateData%BEMT, ErrStat, ErrMsg ) + CALL FVW_DestroyContState( ContStateData%FVW, ErrStat, ErrMsg ) + CALL AA_DestroyContState( ContStateData%AA, ErrStat, ErrMsg ) END SUBROUTINE AD_DestroyContState SUBROUTINE AD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3388,6 +3420,40 @@ SUBROUTINE AD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype + CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -3443,60 +3509,110 @@ SUBROUTINE AD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE AD_PackContState + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE AD_PackContState + + SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) Db_Xferred = Db_Xferred + Buf_size END IF Buf_size=IntKiBuf( Int_Xferred ) @@ -3517,6 +3633,86 @@ SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE AD_UnPackContState SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3536,6 +3732,12 @@ SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt CALL BEMT_CopyDiscState( SrcDiscStateData%BEMT, DstDiscStateData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyDiscState( SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AA_CopyDiscState( SrcDiscStateData%AA, DstDiscStateData%AA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyDiscState SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) @@ -3548,6 +3750,8 @@ SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" CALL BEMT_DestroyDiscState( DiscStateData%BEMT, ErrStat, ErrMsg ) + CALL FVW_DestroyDiscState( DiscStateData%FVW, ErrStat, ErrMsg ) + CALL AA_DestroyDiscState( DiscStateData%AA, ErrStat, ErrMsg ) END SUBROUTINE AD_DestroyDiscState SUBROUTINE AD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3603,6 +3807,40 @@ SUBROUTINE AD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype + CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype + CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -3658,62 +3896,112 @@ SUBROUTINE AD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE AD_PackDiscState + CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE AD_PackDiscState + + SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3732,6 +4020,86 @@ SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE AD_UnPackDiscState SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3751,6 +4119,12 @@ SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, CALL BEMT_CopyConstrState( SrcConstrStateData%BEMT, DstConstrStateData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyConstrState( SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AA_CopyConstrState( SrcConstrStateData%AA, DstConstrStateData%AA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyConstrState SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) @@ -3763,6 +4137,8 @@ SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" CALL BEMT_DestroyConstrState( ConstrStateData%BEMT, ErrStat, ErrMsg ) + CALL FVW_DestroyConstrState( ConstrStateData%FVW, ErrStat, ErrMsg ) + CALL AA_DestroyConstrState( ConstrStateData%AA, ErrStat, ErrMsg ) END SUBROUTINE AD_DestroyConstrState SUBROUTINE AD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3818,6 +4194,40 @@ SUBROUTINE AD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype + CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype + CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -3873,60 +4283,110 @@ SUBROUTINE AD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE AD_PackConstrState + CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE AD_PackConstrState + + SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) Db_Xferred = Db_Xferred + Buf_size END IF Buf_size=IntKiBuf( Int_Xferred ) @@ -3947,6 +4407,86 @@ SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AA_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE AD_UnPackConstrState SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3957,6 +4497,8 @@ SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyOtherState' @@ -3966,6 +4508,26 @@ SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er CALL BEMT_CopyOtherState( SrcOtherStateData%BEMT, DstOtherStateData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyOtherState( SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOtherStateData%WakeLocationPoints)) THEN + i1_l = LBOUND(SrcOtherStateData%WakeLocationPoints,1) + i1_u = UBOUND(SrcOtherStateData%WakeLocationPoints,1) + i2_l = LBOUND(SrcOtherStateData%WakeLocationPoints,2) + i2_u = UBOUND(SrcOtherStateData%WakeLocationPoints,2) + IF (.NOT. ALLOCATED(DstOtherStateData%WakeLocationPoints)) THEN + ALLOCATE(DstOtherStateData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints +ENDIF + CALL AA_CopyOtherState( SrcOtherStateData%AA, DstOtherStateData%AA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyOtherState SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) @@ -3978,6 +4540,11 @@ SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" CALL BEMT_DestroyOtherState( OtherStateData%BEMT, ErrStat, ErrMsg ) + CALL FVW_DestroyOtherState( OtherStateData%FVW, ErrStat, ErrMsg ) +IF (ALLOCATED(OtherStateData%WakeLocationPoints)) THEN + DEALLOCATE(OtherStateData%WakeLocationPoints) +ENDIF + CALL AA_DestroyOtherState( OtherStateData%AA, ErrStat, ErrMsg ) END SUBROUTINE AD_DestroyOtherState SUBROUTINE AD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4033,6 +4600,45 @@ SUBROUTINE AD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype + CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! WakeLocationPoints allocated yes/no + IF ( ALLOCATED(InData%WakeLocationPoints) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WakeLocationPoints upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WakeLocationPoints) ! WakeLocationPoints + END IF + Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype + CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4088,54 +4694,126 @@ SUBROUTINE AD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE AD_PackOtherState + CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%WakeLocationPoints) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WakeLocationPoints,2), UBOUND(InData%WakeLocationPoints,2) + DO i1 = LBOUND(InData%WakeLocationPoints,1), UBOUND(InData%WakeLocationPoints,1) + ReKiBuf(Re_Xferred) = InData%WakeLocationPoints(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE AD_PackOtherState + + SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) @@ -4162,6 +4840,109 @@ SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 FVW_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakeLocationPoints not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WakeLocationPoints)) DEALLOCATE(OutData%WakeLocationPoints) + ALLOCATE(OutData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WakeLocationPoints,2), UBOUND(OutData%WakeLocationPoints,2) + DO i1 = LBOUND(OutData%WakeLocationPoints,1), UBOUND(OutData%WakeLocationPoints,1) + OutData%WakeLocationPoints(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE AD_UnPackOtherState SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -4193,6 +4974,37 @@ SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO + CALL FVW_CopyMisc( SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyOutput( SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMiscData%FVW_u)) THEN + i1_l = LBOUND(SrcMiscData%FVW_u,1) + i1_u = UBOUND(SrcMiscData%FVW_u,1) + IF (.NOT. ALLOCATED(DstMiscData%FVW_u)) THEN + ALLOCATE(DstMiscData%FVW_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%FVW_u,1), UBOUND(SrcMiscData%FVW_u,1) + CALL FVW_CopyInput( SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL AA_CopyMisc( SrcMiscData%AA, DstMiscData%AA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AA_CopyOutput( SrcMiscData%AA_y, DstMiscData%AA_y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AA_CopyInput( SrcMiscData%AA_u, DstMiscData%AA_u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcMiscData%DisturbedInflow)) THEN i1_l = LBOUND(SrcMiscData%DisturbedInflow,1) i1_u = UBOUND(SrcMiscData%DisturbedInflow,1) @@ -4425,6 +5237,17 @@ SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg ) DO i1 = LBOUND(MiscData%BEMT_u,1), UBOUND(MiscData%BEMT_u,1) CALL BEMT_DestroyInput( MiscData%BEMT_u(i1), ErrStat, ErrMsg ) ENDDO + CALL FVW_DestroyMisc( MiscData%FVW, ErrStat, ErrMsg ) + CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(MiscData%FVW_u) +ENDIF + CALL AA_DestroyMisc( MiscData%AA, ErrStat, ErrMsg ) + CALL AA_DestroyOutput( MiscData%AA_y, ErrStat, ErrMsg ) + CALL AA_DestroyInput( MiscData%AA_u, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%DisturbedInflow)) THEN DEALLOCATE(MiscData%DisturbedInflow) ENDIF @@ -4565,10 +5388,118 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz DEALLOCATE(Int_Buf) END IF END DO - Int_BufSz = Int_BufSz + 1 ! DisturbedInflow allocated yes/no - IF ( ALLOCATED(InData%DisturbedInflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisturbedInflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DisturbedInflow) ! DisturbedInflow + Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype + CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! FVW_y: size of buffers for each call to pack subtype + CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, .TRUE. ) ! FVW_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW_y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW_y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW_y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! FVW_u allocated yes/no + IF ( ALLOCATED(InData%FVW_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FVW_u upper/lower bounds for each dimension + DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) + Int_BufSz = Int_BufSz + 3 ! FVW_u: size of buffers for each call to pack subtype + CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FVW_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW_u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW_u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW_u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype + CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AA_y: size of buffers for each call to pack subtype + CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, .TRUE. ) ! AA_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA_y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA_y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA_y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AA_u: size of buffers for each call to pack subtype + CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, .TRUE. ) ! AA_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA_u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA_u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA_u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! DisturbedInflow allocated yes/no + IF ( ALLOCATED(InData%DisturbedInflow) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! DisturbedInflow upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%DisturbedInflow) ! DisturbedInflow END IF Int_BufSz = Int_BufSz + 1 ! WithoutSweepPitchTwist allocated yes/no IF ( ALLOCATED(InData%WithoutSweepPitchTwist) ) THEN @@ -4791,6 +5722,187 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, OnlySize ) ! FVW_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%FVW_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FVW_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FVW_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) + CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! FVW_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, OnlySize ) ! AA_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, OnlySize ) ! AA_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF IF ( .NOT. ALLOCATED(InData%DisturbedInflow) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4807,8 +5919,14 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DisturbedInflow)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DisturbedInflow))-1 ) = PACK(InData%DisturbedInflow,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DisturbedInflow) + DO i3 = LBOUND(InData%DisturbedInflow,3), UBOUND(InData%DisturbedInflow,3) + DO i2 = LBOUND(InData%DisturbedInflow,2), UBOUND(InData%DisturbedInflow,2) + DO i1 = LBOUND(InData%DisturbedInflow,1), UBOUND(InData%DisturbedInflow,1) + ReKiBuf(Re_Xferred) = InData%DisturbedInflow(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WithoutSweepPitchTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4829,8 +5947,16 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WithoutSweepPitchTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WithoutSweepPitchTwist))-1 ) = PACK(InData%WithoutSweepPitchTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WithoutSweepPitchTwist) + DO i4 = LBOUND(InData%WithoutSweepPitchTwist,4), UBOUND(InData%WithoutSweepPitchTwist,4) + DO i3 = LBOUND(InData%WithoutSweepPitchTwist,3), UBOUND(InData%WithoutSweepPitchTwist,3) + DO i2 = LBOUND(InData%WithoutSweepPitchTwist,2), UBOUND(InData%WithoutSweepPitchTwist,2) + DO i1 = LBOUND(InData%WithoutSweepPitchTwist,1), UBOUND(InData%WithoutSweepPitchTwist,1) + ReKiBuf(Re_Xferred) = InData%WithoutSweepPitchTwist(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4842,8 +5968,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%W_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4855,8 +5983,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W_Twr))-1 ) = PACK(InData%W_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W_Twr) + DO i1 = LBOUND(InData%W_Twr,1), UBOUND(InData%W_Twr,1) + ReKiBuf(Re_Xferred) = InData%W_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%X_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4868,8 +5998,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X_Twr))-1 ) = PACK(InData%X_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X_Twr) + DO i1 = LBOUND(InData%X_Twr,1), UBOUND(InData%X_Twr,1) + ReKiBuf(Re_Xferred) = InData%X_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Y_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4881,8 +6013,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y_Twr))-1 ) = PACK(InData%Y_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y_Twr) + DO i1 = LBOUND(InData%Y_Twr,1), UBOUND(InData%Y_Twr,1) + ReKiBuf(Re_Xferred) = InData%Y_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Curve) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4897,8 +6031,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Curve)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Curve))-1 ) = PACK(InData%Curve,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Curve) + DO i2 = LBOUND(InData%Curve,2), UBOUND(InData%Curve,2) + DO i1 = LBOUND(InData%Curve,1), UBOUND(InData%Curve,1) + ReKiBuf(Re_Xferred) = InData%Curve(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrClrnc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4913,8 +6051,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrClrnc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrClrnc))-1 ) = PACK(InData%TwrClrnc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrClrnc) + DO i2 = LBOUND(InData%TwrClrnc,2), UBOUND(InData%TwrClrnc,2) + DO i1 = LBOUND(InData%TwrClrnc,1), UBOUND(InData%TwrClrnc,1) + ReKiBuf(Re_Xferred) = InData%TwrClrnc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4929,8 +6071,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X))-1 ) = PACK(InData%X,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X) + DO i2 = LBOUND(InData%X,2), UBOUND(InData%X,2) + DO i1 = LBOUND(InData%X,1), UBOUND(InData%X,1) + ReKiBuf(Re_Xferred) = InData%X(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4945,8 +6091,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y))-1 ) = PACK(InData%Y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y) + DO i2 = LBOUND(InData%Y,2), UBOUND(InData%Y,2) + DO i1 = LBOUND(InData%Y,1), UBOUND(InData%Y,1) + ReKiBuf(Re_Xferred) = InData%Y(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4961,15 +6111,23 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V_DiskAvg))-1 ) = PACK(InData%V_DiskAvg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V_DiskAvg) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%hub_theta_x_root))-1 ) = PACK(InData%hub_theta_x_root,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%hub_theta_x_root) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V_dot_x - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) + ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%hub_theta_x_root,1), UBOUND(InData%hub_theta_x_root,1) + ReKiBuf(Re_Xferred) = InData%hub_theta_x_root(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%V_dot_x + Re_Xferred = Re_Xferred + 1 CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5052,8 +6210,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SigmaCavitCrit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaCavitCrit))-1 ) = PACK(InData%SigmaCavitCrit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaCavitCrit) + DO i2 = LBOUND(InData%SigmaCavitCrit,2), UBOUND(InData%SigmaCavitCrit,2) + DO i1 = LBOUND(InData%SigmaCavitCrit,1), UBOUND(InData%SigmaCavitCrit,1) + ReKiBuf(Re_Xferred) = InData%SigmaCavitCrit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SigmaCavit) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5068,8 +6230,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SigmaCavit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaCavit))-1 ) = PACK(InData%SigmaCavit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaCavit) + DO i2 = LBOUND(InData%SigmaCavit,2), UBOUND(InData%SigmaCavit,2) + DO i1 = LBOUND(InData%SigmaCavit,1), UBOUND(InData%SigmaCavit,1) + ReKiBuf(Re_Xferred) = InData%SigmaCavit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CavitWarnSet) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5084,47 +6250,305 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CavitWarnSet)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%CavitWarnSet)-1 ) = TRANSFER(PACK( InData%CavitWarnSet ,.TRUE.), IntKiBuf(1), SIZE(InData%CavitWarnSet)) - Int_Xferred = Int_Xferred + SIZE(InData%CavitWarnSet) + DO i2 = LBOUND(InData%CavitWarnSet,2), UBOUND(InData%CavitWarnSet,2) + DO i1 = LBOUND(InData%CavitWarnSet,1), UBOUND(InData%CavitWarnSet,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitWarnSet(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE AD_PackMisc + + SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BEMT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_y, ErrStat2, ErrMsg2 ) ! BEMT_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%BEMT_u,1) + i1_u = UBOUND(OutData%BEMT_u,1) + DO i1 = LBOUND(OutData%BEMT_u,1), UBOUND(OutData%BEMT_u,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_u(i1), ErrStat2, ErrMsg2 ) ! BEMT_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_y, ErrStat2, ErrMsg2 ) ! FVW_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FVW_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FVW_u)) DEALLOCATE(OutData%FVW_u) + ALLOCATE(OutData%FVW_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FVW_u,1), UBOUND(OutData%FVW_u,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_u(i1), ErrStat2, ErrMsg2 ) ! FVW_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO END IF - END SUBROUTINE AD_PackMisc - - SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5158,7 +6582,7 @@ SUBROUTINE AD_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 BEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT + CALL AA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5198,16 +6622,13 @@ SUBROUTINE AD_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 BEMT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_y, ErrStat2, ErrMsg2 ) ! BEMT_y + CALL AA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_y, ErrStat2, ErrMsg2 ) ! AA_y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%BEMT_u,1) - i1_u = UBOUND(OutData%BEMT_u,1) - DO i1 = LBOUND(OutData%BEMT_u,1), UBOUND(OutData%BEMT_u,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5241,14 +6662,13 @@ SUBROUTINE AD_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 BEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_u(i1), ErrStat2, ErrMsg2 ) ! BEMT_u + CALL AA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_u, ErrStat2, ErrMsg2 ) ! AA_u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisturbedInflow not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5268,15 +6688,14 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DisturbedInflow)>0) OutData%DisturbedInflow = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DisturbedInflow))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DisturbedInflow) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DisturbedInflow,3), UBOUND(OutData%DisturbedInflow,3) + DO i2 = LBOUND(OutData%DisturbedInflow,2), UBOUND(OutData%DisturbedInflow,2) + DO i1 = LBOUND(OutData%DisturbedInflow,1), UBOUND(OutData%DisturbedInflow,1) + OutData%DisturbedInflow(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WithoutSweepPitchTwist not allocated Int_Xferred = Int_Xferred + 1 @@ -5300,15 +6719,16 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%WithoutSweepPitchTwist)>0) OutData%WithoutSweepPitchTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WithoutSweepPitchTwist))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WithoutSweepPitchTwist) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%WithoutSweepPitchTwist,4), UBOUND(OutData%WithoutSweepPitchTwist,4) + DO i3 = LBOUND(OutData%WithoutSweepPitchTwist,3), UBOUND(OutData%WithoutSweepPitchTwist,3) + DO i2 = LBOUND(OutData%WithoutSweepPitchTwist,2), UBOUND(OutData%WithoutSweepPitchTwist,2) + DO i1 = LBOUND(OutData%WithoutSweepPitchTwist,1), UBOUND(OutData%WithoutSweepPitchTwist,1) + OutData%WithoutSweepPitchTwist(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 @@ -5323,15 +6743,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5346,15 +6761,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%W_Twr)>0) OutData%W_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%W_Twr,1), UBOUND(OutData%W_Twr,1) + OutData%W_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5369,15 +6779,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%X_Twr)>0) OutData%X_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%X_Twr,1), UBOUND(OutData%X_Twr,1) + OutData%X_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5392,15 +6797,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y_Twr)>0) OutData%Y_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y_Twr,1), UBOUND(OutData%Y_Twr,1) + OutData%Y_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Curve not allocated Int_Xferred = Int_Xferred + 1 @@ -5418,15 +6818,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Curve)>0) OutData%Curve = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Curve))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Curve) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Curve,2), UBOUND(OutData%Curve,2) + DO i1 = LBOUND(OutData%Curve,1), UBOUND(OutData%Curve,1) + OutData%Curve(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrClrnc not allocated Int_Xferred = Int_Xferred + 1 @@ -5444,15 +6841,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrClrnc)>0) OutData%TwrClrnc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrClrnc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrClrnc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrClrnc,2), UBOUND(OutData%TwrClrnc,2) + DO i1 = LBOUND(OutData%TwrClrnc,1), UBOUND(OutData%TwrClrnc,1) + OutData%TwrClrnc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X not allocated Int_Xferred = Int_Xferred + 1 @@ -5470,15 +6864,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X)>0) OutData%X = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X,2), UBOUND(OutData%X,2) + DO i1 = LBOUND(OutData%X,1), UBOUND(OutData%X,1) + OutData%X(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y not allocated Int_Xferred = Int_Xferred + 1 @@ -5496,15 +6887,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Y)>0) OutData%Y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Y,2), UBOUND(OutData%Y,2) + DO i1 = LBOUND(OutData%Y,1), UBOUND(OutData%Y,1) + OutData%Y(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -5522,40 +6910,27 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%V_DiskAvg,1) i1_u = UBOUND(OutData%V_DiskAvg,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%V_DiskAvg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V_DiskAvg))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V_DiskAvg) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V_DiskAvg,1), UBOUND(OutData%V_DiskAvg,1) + OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%hub_theta_x_root,1) i1_u = UBOUND(OutData%hub_theta_x_root,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%hub_theta_x_root = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%hub_theta_x_root))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%hub_theta_x_root) - DEALLOCATE(mask1) - OutData%V_dot_x = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%hub_theta_x_root,1), UBOUND(OutData%hub_theta_x_root,1) + OutData%hub_theta_x_root(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%V_dot_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5668,15 +7043,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SigmaCavitCrit)>0) OutData%SigmaCavitCrit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaCavitCrit))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaCavitCrit) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SigmaCavitCrit,2), UBOUND(OutData%SigmaCavitCrit,2) + DO i1 = LBOUND(OutData%SigmaCavitCrit,1), UBOUND(OutData%SigmaCavitCrit,1) + OutData%SigmaCavitCrit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavit not allocated Int_Xferred = Int_Xferred + 1 @@ -5694,15 +7066,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SigmaCavit)>0) OutData%SigmaCavit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaCavit))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaCavit) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SigmaCavit,2), UBOUND(OutData%SigmaCavit,2) + DO i1 = LBOUND(OutData%SigmaCavit,1), UBOUND(OutData%SigmaCavit,1) + OutData%SigmaCavit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CavitWarnSet not allocated Int_Xferred = Int_Xferred + 1 @@ -5720,15 +7089,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CavitWarnSet)>0) OutData%CavitWarnSet = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%CavitWarnSet))-1 ), OutData%CavitWarnSet), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%CavitWarnSet) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CavitWarnSet,2), UBOUND(OutData%CavitWarnSet,2) + DO i1 = LBOUND(OutData%CavitWarnSet,1), UBOUND(OutData%CavitWarnSet,1) + OutData%CavitWarnSet(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitWarnSet(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_UnPackMisc @@ -5755,6 +7121,7 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%TwrAero = SrcParamData%TwrAero DstParamData%FrozenWake = SrcParamData%FrozenWake DstParamData%CavitCheck = SrcParamData%CavitCheck + DstParamData%CompAA = SrcParamData%CompAA DstParamData%NumBlades = SrcParamData%NumBlades DstParamData%NumBlNds = SrcParamData%NumBlNds DstParamData%NumTwrNds = SrcParamData%NumTwrNds @@ -5808,6 +7175,12 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) CALL BEMT_CopyParam( SrcParamData%BEMT, DstParamData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyParam( SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AA_CopyParam( SrcParamData%AA, DstParamData%AA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%RootName = SrcParamData%RootName IF (ALLOCATED(SrcParamData%OutParam)) THEN @@ -5830,6 +7203,37 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%BlOutNd = SrcParamData%BlOutNd DstParamData%NTwOuts = SrcParamData%NTwOuts DstParamData%TwOutNd = SrcParamData%TwOutNd + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN + ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN i1_l = LBOUND(SrcParamData%Jac_u_indx,1) i1_u = UBOUND(SrcParamData%Jac_u_indx,1) @@ -5881,12 +7285,23 @@ SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) DEALLOCATE(ParamData%AFI) ENDIF CALL BEMT_DestroyParam( ParamData%BEMT, ErrStat, ErrMsg ) + CALL FVW_DestroyParam( ParamData%FVW, ErrStat, ErrMsg ) + CALL AA_DestroyParam( ParamData%AA, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF +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 ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN + DEALLOCATE(ParamData%BldNd_BlOutNd) +ENDIF IF (ALLOCATED(ParamData%Jac_u_indx)) THEN DEALLOCATE(ParamData%Jac_u_indx) ENDIF @@ -5937,6 +7352,7 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! TwrAero Int_BufSz = Int_BufSz + 1 ! FrozenWake Int_BufSz = Int_BufSz + 1 ! CavitCheck + Int_BufSz = Int_BufSz + 1 ! CompAA Int_BufSz = Int_BufSz + 1 ! NumBlades Int_BufSz = Int_BufSz + 1 ! NumBlNds Int_BufSz = Int_BufSz + 1 ! NumTwrNds @@ -5998,6 +7414,40 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype + CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FVW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FVW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FVW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype + CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! NumOuts Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no @@ -6027,6 +7477,37 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd Int_BufSz = Int_BufSz + 1 ! NTwOuts Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! 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 @@ -6065,26 +7546,28 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CavitCheck , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrPotent + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6095,8 +7578,10 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6108,23 +7593,25 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCd))-1 ) = PACK(InData%TwrCd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCd) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FluidDepth - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) + ReKiBuf(Re_Xferred) = InData%TwrCd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FluidDepth + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6194,24 +7681,137 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NBlOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NTwOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) + IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6241,14 +7841,23 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlOutNd))-1 ) = PACK(InData%BlOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwOutNd))-1 ) = PACK(InData%TwOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwOutNd) + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6262,8 +7871,12 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6275,11 +7888,13 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + ReKiBuf(Re_Xferred) = InData%du(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackParam SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6295,12 +7910,6 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6316,26 +7925,28 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) + Int_Xferred = Int_Xferred + 1 + OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) + Int_Xferred = Int_Xferred + 1 + OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6349,15 +7960,10 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated Int_Xferred = Int_Xferred + 1 @@ -6372,30 +7978,25 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrCd)>0) OutData%TwrCd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCd) - DEALLOCATE(mask1) - END IF - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FluidDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) + OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FluidDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6492,12 +8093,92 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FVW_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6554,32 +8235,102 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NBlOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NBlOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlOutNd,1) i1_u = UBOUND(OutData%BlOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) + OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NTwOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%TwOutNd,1) + i1_u = UBOUND(OutData%TwOutNd,1) + DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) + OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%BlOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlOutNd) - DEALLOCATE(mask1) - OutData%NTwOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%TwOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwOutNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6596,15 +8347,12 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -6619,18 +8367,13 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackParam SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -6731,6 +8474,20 @@ SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) END IF END IF DstInputData%UserProp = SrcInputData%UserProp +ENDIF +IF (ALLOCATED(SrcInputData%InflowWakeVel)) THEN + i1_l = LBOUND(SrcInputData%InflowWakeVel,1) + i1_u = UBOUND(SrcInputData%InflowWakeVel,1) + i2_l = LBOUND(SrcInputData%InflowWakeVel,2) + i2_u = UBOUND(SrcInputData%InflowWakeVel,2) + IF (.NOT. ALLOCATED(DstInputData%InflowWakeVel)) THEN + ALLOCATE(DstInputData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel ENDIF END SUBROUTINE AD_CopyInput @@ -6765,6 +8522,9 @@ SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputData%UserProp)) THEN DEALLOCATE(InputData%UserProp) +ENDIF +IF (ALLOCATED(InputData%InflowWakeVel)) THEN + DEALLOCATE(InputData%InflowWakeVel) ENDIF END SUBROUTINE AD_DestroyInput @@ -6899,6 +8659,11 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp END IF + Int_BufSz = Int_BufSz + 1 ! InflowWakeVel allocated yes/no + IF ( ALLOCATED(InData%InflowWakeVel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! InflowWakeVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%InflowWakeVel) ! InflowWakeVel + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -7080,8 +8845,14 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowOnBlade)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowOnBlade))-1 ) = PACK(InData%InflowOnBlade,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowOnBlade) + DO i3 = LBOUND(InData%InflowOnBlade,3), UBOUND(InData%InflowOnBlade,3) + DO i2 = LBOUND(InData%InflowOnBlade,2), UBOUND(InData%InflowOnBlade,2) + DO i1 = LBOUND(InData%InflowOnBlade,1), UBOUND(InData%InflowOnBlade,1) + ReKiBuf(Re_Xferred) = InData%InflowOnBlade(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InflowOnTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7096,8 +8867,12 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowOnTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowOnTower))-1 ) = PACK(InData%InflowOnTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowOnTower) + DO i2 = LBOUND(InData%InflowOnTower,2), UBOUND(InData%InflowOnTower,2) + DO i1 = LBOUND(InData%InflowOnTower,1), UBOUND(InData%InflowOnTower,1) + ReKiBuf(Re_Xferred) = InData%InflowOnTower(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7112,8 +8887,32 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UserProp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UserProp))-1 ) = PACK(InData%UserProp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UserProp) + DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) + DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) + ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InflowWakeVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%InflowWakeVel,2), UBOUND(InData%InflowWakeVel,2) + DO i1 = LBOUND(InData%InflowWakeVel,1), UBOUND(InData%InflowWakeVel,1) + ReKiBuf(Re_Xferred) = InData%InflowWakeVel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_PackInput @@ -7130,12 +8929,6 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -7363,15 +9156,14 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%InflowOnBlade)>0) OutData%InflowOnBlade = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowOnBlade))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowOnBlade) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%InflowOnBlade,3), UBOUND(OutData%InflowOnBlade,3) + DO i2 = LBOUND(OutData%InflowOnBlade,2), UBOUND(OutData%InflowOnBlade,2) + DO i1 = LBOUND(OutData%InflowOnBlade,1), UBOUND(OutData%InflowOnBlade,1) + OutData%InflowOnBlade(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowOnTower not allocated Int_Xferred = Int_Xferred + 1 @@ -7389,15 +9181,12 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InflowOnTower)>0) OutData%InflowOnTower = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowOnTower))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowOnTower) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowOnTower,2), UBOUND(OutData%InflowOnTower,2) + DO i1 = LBOUND(OutData%InflowOnTower,1), UBOUND(OutData%InflowOnTower,1) + OutData%InflowOnTower(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 @@ -7415,15 +9204,35 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) + DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) + OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowWakeVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InflowWakeVel)) DEALLOCATE(OutData%InflowWakeVel) + ALLOCATE(OutData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%UserProp)>0) OutData%UserProp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UserProp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UserProp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowWakeVel,2), UBOUND(OutData%InflowWakeVel,2) + DO i1 = LBOUND(OutData%InflowWakeVel,1), UBOUND(OutData%InflowWakeVel,1) + OutData%InflowWakeVel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_UnPackInput @@ -7683,8 +9492,10 @@ SUBROUTINE AD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackOutput @@ -7701,12 +9512,6 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7830,15 +9635,10 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackOutput @@ -7917,17 +9717,16 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7940,47 +9739,57 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%TowerMotion, u2%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i01 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(u1%BladeRootMotion(i01), u2%BladeRootMotion(i01), tin, u_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i01 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) - CALL MeshExtrapInterp1(u1%BladeMotion(i01), u2%BladeMotion(i01), tin, u_out%BladeMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) + CALL MeshExtrapInterp1(u1%BladeMotion(i1), u2%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnBlade) .AND. ALLOCATED(u1%InflowOnBlade)) THEN - ALLOCATE(b3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - ALLOCATE(c3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - b3 = -(u1%InflowOnBlade - u2%InflowOnBlade)/t(2) - u_out%InflowOnBlade = u1%InflowOnBlade + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%InflowOnBlade,3),UBOUND(u_out%InflowOnBlade,3) + DO i2 = LBOUND(u_out%InflowOnBlade,2),UBOUND(u_out%InflowOnBlade,2) + DO i1 = LBOUND(u_out%InflowOnBlade,1),UBOUND(u_out%InflowOnBlade,1) + b = -(u1%InflowOnBlade(i1,i2,i3) - u2%InflowOnBlade(i1,i2,i3)) + u_out%InflowOnBlade(i1,i2,i3) = u1%InflowOnBlade(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnTower) .AND. ALLOCATED(u1%InflowOnTower)) THEN - ALLOCATE(b2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - ALLOCATE(c2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - b2 = -(u1%InflowOnTower - u2%InflowOnTower)/t(2) - u_out%InflowOnTower = u1%InflowOnTower + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowOnTower,2),UBOUND(u_out%InflowOnTower,2) + DO i1 = LBOUND(u_out%InflowOnTower,1),UBOUND(u_out%InflowOnTower,1) + b = -(u1%InflowOnTower(i1,i2) - u2%InflowOnTower(i1,i2)) + u_out%InflowOnTower(i1,i2) = u1%InflowOnTower(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) + DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) + b = -(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) + u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE AD_Input_ExtrapInterp1 @@ -8011,18 +9820,18 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8041,50 +9850,61 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%TowerMotion, u2%TowerMotion, u3%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i01 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(u1%BladeRootMotion(i01), u2%BladeRootMotion(i01), u3%BladeRootMotion(i01), tin, u_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), u3%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i01 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) - CALL MeshExtrapInterp2(u1%BladeMotion(i01), u2%BladeMotion(i01), u3%BladeMotion(i01), tin, u_out%BladeMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) + CALL MeshExtrapInterp2(u1%BladeMotion(i1), u2%BladeMotion(i1), u3%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnBlade) .AND. ALLOCATED(u1%InflowOnBlade)) THEN - ALLOCATE(b3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - ALLOCATE(c3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - b3 = (t(3)**2*(u1%InflowOnBlade - u2%InflowOnBlade) + t(2)**2*(-u1%InflowOnBlade + u3%InflowOnBlade))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%InflowOnBlade + t(3)*u2%InflowOnBlade - t(2)*u3%InflowOnBlade ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowOnBlade = u1%InflowOnBlade + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%InflowOnBlade,3),UBOUND(u_out%InflowOnBlade,3) + DO i2 = LBOUND(u_out%InflowOnBlade,2),UBOUND(u_out%InflowOnBlade,2) + DO i1 = LBOUND(u_out%InflowOnBlade,1),UBOUND(u_out%InflowOnBlade,1) + b = (t(3)**2*(u1%InflowOnBlade(i1,i2,i3) - u2%InflowOnBlade(i1,i2,i3)) + t(2)**2*(-u1%InflowOnBlade(i1,i2,i3) + u3%InflowOnBlade(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowOnBlade(i1,i2,i3) + t(3)*u2%InflowOnBlade(i1,i2,i3) - t(2)*u3%InflowOnBlade(i1,i2,i3) ) * scaleFactor + u_out%InflowOnBlade(i1,i2,i3) = u1%InflowOnBlade(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnTower) .AND. ALLOCATED(u1%InflowOnTower)) THEN - ALLOCATE(b2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - ALLOCATE(c2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - b2 = (t(3)**2*(u1%InflowOnTower - u2%InflowOnTower) + t(2)**2*(-u1%InflowOnTower + u3%InflowOnTower))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%InflowOnTower + t(3)*u2%InflowOnTower - t(2)*u3%InflowOnTower ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowOnTower = u1%InflowOnTower + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowOnTower,2),UBOUND(u_out%InflowOnTower,2) + DO i1 = LBOUND(u_out%InflowOnTower,1),UBOUND(u_out%InflowOnTower,1) + b = (t(3)**2*(u1%InflowOnTower(i1,i2) - u2%InflowOnTower(i1,i2)) + t(2)**2*(-u1%InflowOnTower(i1,i2) + u3%InflowOnTower(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowOnTower(i1,i2) + t(3)*u2%InflowOnTower(i1,i2) - t(2)*u3%InflowOnTower(i1,i2) ) * scaleFactor + u_out%InflowOnTower(i1,i2) = u1%InflowOnTower(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) + DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) + b = (t(3)**2*(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) + t(2)**2*(-u1%InflowWakeVel(i1,i2) + u3%InflowWakeVel(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowWakeVel(i1,i2) + t(3)*u2%InflowWakeVel(i1,i2) - t(2)*u3%InflowWakeVel(i1,i2) ) * scaleFactor + u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE AD_Input_ExtrapInterp2 @@ -8163,13 +9983,12 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8182,21 +10001,21 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%TowerLoad, y2%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i01 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) - CALL MeshExtrapInterp1(y1%BladeLoad(i01), y2%BladeLoad(i01), tin, y_out%BladeLoad(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) + CALL MeshExtrapInterp1(y1%BladeLoad(i1), y2%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE AD_Output_ExtrapInterp1 @@ -8227,14 +10046,14 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8253,22 +10072,22 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%TowerLoad, y2%TowerLoad, y3%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i01 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) - CALL MeshExtrapInterp2(y1%BladeLoad(i01), y2%BladeLoad(i01), y3%BladeLoad(i01), tin, y_out%BladeLoad(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) + CALL MeshExtrapInterp2(y1%BladeLoad(i1), y2%BladeLoad(i1), y3%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE AD_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index 89b1c6d100..1859c63bdd 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -406,11 +406,13 @@ SUBROUTINE ReadAFfile ( AFfile, NumCoefs, InCol_Alfa, InCol_Cl, InCol_Cd, InCol_ CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ReadAFfile' CHARACTER(10) :: defaultStr - + CHARACTER(1024) :: PriPath + ErrStat = ErrID_None ErrMsg = "" defaultStr = "" - + ! Getting parent folder of airfoils data (e.g. "Arifoils/") + CALL GetPath( AFFile, PriPath ) ! Process the (possibly) nested set of files. This copies the decommented contents of ! AFI_FileInfo%FileName and the files it includes (both directly and indirectly) into ! the FileInfo structure that we can then parse. @@ -477,9 +479,13 @@ SUBROUTINE ReadAFfile ( AFfile, NumCoefs, InCol_Alfa, InCol_Cl, InCol_Cd, InCol_ ENDDO ! Row ENDIF - - - ! How many columns do we need to read in the input and how many total coefficients will be used? + + ! Reading Boundary layer file for aeroacoustics + CALL ParseVar ( FileInfo, CurLine, 'BL_file' , p%BL_file , ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PathIsRelative( p%BL_file ) ) p%BL_file=trim(PriPath)//trim(p%BL_file) + + ! How many columns do we need to read in the input and how many total coefficients will be used? Cols2Parse = MAX( InCol_Alfa, InCol_Cl, InCol_Cd, InCol_Cm, InCol_Cpmin ) ALLOCATE ( SiAry( Cols2Parse ) , STAT=ErrStat2 ) diff --git a/modules/aerodyn/src/AirfoilInfo_Registry.txt b/modules/aerodyn/src/AirfoilInfo_Registry.txt index ed5e4b3e97..7e2501002e 100644 --- a/modules/aerodyn/src/AirfoilInfo_Registry.txt +++ b/modules/aerodyn/src/AirfoilInfo_Registry.txt @@ -96,6 +96,7 @@ typedef ^ ^ ReKi X_Coord typedef ^ ^ ReKi Y_Coord {:} - - "Y-coordinate for the airfoil shape [unused]" - typedef ^ ^ INTEGER NumTabs - - - "The number of airfoil tables in the airfoil file" - typedef ^ ^ AFI_Table_Type Table {:} - - "The tables of airfoil data for given Re and control setting" - +typedef ^ ^ CHARACTER(1024) BL_file - - - "The name of the file with the boundary layer data" # ..... Inputs .................................................................................................................... # Define inputs that are not on this mesh here: diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 0e78d0faf9..4c9b15d311 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -116,6 +116,7 @@ MODULE AirfoilInfo_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Coord !< Y-coordinate for the airfoil shape [unused] [-] INTEGER(IntKi) :: NumTabs !< The number of airfoil tables in the airfoil file [-] TYPE(AFI_Table_Type) , DIMENSION(:), ALLOCATABLE :: Table !< The tables of airfoil data for given Re and control setting [-] + CHARACTER(1024) :: BL_file !< The name of the file with the boundary layer data [-] END TYPE AFI_ParameterType ! ======================= ! ========= AFI_InputType ======= @@ -292,70 +293,70 @@ SUBROUTINE AFI_PackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%eta_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_nalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_f0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_p - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_VL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%St_sh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k1_hat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%x_cp_bar - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UACutout - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%filtCutOff - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%eta_e + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_nalpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_f0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_V0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_p + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_VL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S4 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%St_sh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k1_hat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%x_cp_bar + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UACutout + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%filtCutOff + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackUA_BL_Type SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -371,12 +372,6 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -393,70 +388,70 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%alpha0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%eta_e = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_f0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_V0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_p = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_VL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S4 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%St_sh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k1_hat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%x_cp_bar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%filtCutOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%alpha0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%eta_e = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_nalpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_f0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_V0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_p = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_VL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S4 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%St_sh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k1_hat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%x_cp_bar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UACutout = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%filtCutOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackUA_BL_Type SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) @@ -659,8 +654,10 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Alpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Alpha))-1 ) = PACK(InData%Alpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Alpha) + DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) + ReKiBuf(Re_Xferred) = InData%Alpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Coefs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -675,8 +672,12 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Coefs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Coefs))-1 ) = PACK(InData%Coefs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Coefs) + DO i2 = LBOUND(InData%Coefs,2), UBOUND(InData%Coefs,2) + DO i1 = LBOUND(InData%Coefs,1), UBOUND(InData%Coefs,1) + ReKiBuf(Re_Xferred) = InData%Coefs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SplineCoefs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -694,19 +695,25 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SplineCoefs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SplineCoefs))-1 ) = PACK(InData%SplineCoefs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SplineCoefs) + DO i3 = LBOUND(InData%SplineCoefs,3), UBOUND(InData%SplineCoefs,3) + DO i2 = LBOUND(InData%SplineCoefs,2), UBOUND(InData%SplineCoefs,2) + DO i1 = LBOUND(InData%SplineCoefs,1), UBOUND(InData%SplineCoefs,1) + ReKiBuf(Re_Xferred) = InData%SplineCoefs(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumAlf - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ConstData , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%InclUAdata , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumAlf + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstData, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InclUAdata, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -750,12 +757,6 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -785,15 +786,10 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Alpha)>0) OutData%Alpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Alpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Alpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) + OutData%Alpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Coefs not allocated Int_Xferred = Int_Xferred + 1 @@ -811,15 +807,12 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Coefs)>0) OutData%Coefs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Coefs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Coefs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Coefs,2), UBOUND(OutData%Coefs,2) + DO i1 = LBOUND(OutData%Coefs,1), UBOUND(OutData%Coefs,1) + OutData%Coefs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SplineCoefs not allocated Int_Xferred = Int_Xferred + 1 @@ -840,26 +833,25 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SplineCoefs)>0) OutData%SplineCoefs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SplineCoefs))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SplineCoefs) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%SplineCoefs,3), UBOUND(OutData%SplineCoefs,3) + DO i2 = LBOUND(OutData%SplineCoefs,2), UBOUND(OutData%SplineCoefs,2) + DO i1 = LBOUND(OutData%SplineCoefs,1), UBOUND(OutData%SplineCoefs,1) + OutData%SplineCoefs(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumAlf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ConstData = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%InclUAdata = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumAlf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ConstData = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstData) + Int_Xferred = Int_Xferred + 1 + OutData%InclUAdata = TRANSFER(IntKiBuf(Int_Xferred), OutData%InclUAdata) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1005,22 +997,22 @@ SUBROUTINE AFI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Alfa - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cd - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cm - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cpmin - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Alfa + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cd + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cm + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cpmin + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AFI_PackInitInput SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1036,12 +1028,6 @@ SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitInput' @@ -1055,22 +1041,22 @@ SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cm = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cpmin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Alfa = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cm = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cpmin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AFI_UnPackInitInput SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1227,12 +1213,6 @@ SUBROUTINE AFI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitOutput' @@ -1364,6 +1344,7 @@ SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF + DstParamData%BL_file = SrcParamData%BL_file END SUBROUTINE AFI_CopyParam SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -1475,6 +1456,7 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END IF END DO END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BL_file) ! BL_file IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1502,16 +1484,16 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCd - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCm - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCd + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCm + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCpmin + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%secondVals) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1522,15 +1504,17 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%secondVals,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%secondVals)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%secondVals))-1 ) = PACK(InData%secondVals,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%secondVals) + DO i1 = LBOUND(InData%secondVals,1), UBOUND(InData%secondVals,1) + ReKiBuf(Re_Xferred) = InData%secondVals(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InterpOrd - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NonDimArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCoords - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InterpOrd + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NonDimArea + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCoords + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%X_Coord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1541,8 +1525,10 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Coord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X_Coord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X_Coord))-1 ) = PACK(InData%X_Coord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X_Coord) + DO i1 = LBOUND(InData%X_Coord,1), UBOUND(InData%X_Coord,1) + ReKiBuf(Re_Xferred) = InData%X_Coord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Y_Coord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1554,11 +1540,13 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Coord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y_Coord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y_Coord))-1 ) = PACK(InData%Y_Coord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y_Coord) + DO i1 = LBOUND(InData%Y_Coord,1), UBOUND(InData%Y_Coord,1) + ReKiBuf(Re_Xferred) = InData%Y_Coord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTabs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTabs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Table) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1600,6 +1588,10 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ENDIF END DO END IF + DO I = 1, LEN(InData%BL_file) + IntKiBuf(Int_Xferred) = ICHAR(InData%BL_file(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE AFI_PackParam SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1615,12 +1607,6 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1635,16 +1621,16 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%ColCd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCm = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCpmin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%ColCd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCm = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCpmin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! secondVals not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1658,22 +1644,17 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%secondVals)>0) OutData%secondVals = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%secondVals))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%secondVals) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%secondVals,1), UBOUND(OutData%secondVals,1) + OutData%secondVals(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%InterpOrd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NonDimArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumCoords = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%InterpOrd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NonDimArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumCoords = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Coord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1687,15 +1668,10 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%X_Coord)>0) OutData%X_Coord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X_Coord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X_Coord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%X_Coord,1), UBOUND(OutData%X_Coord,1) + OutData%X_Coord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Coord not allocated Int_Xferred = Int_Xferred + 1 @@ -1710,18 +1686,13 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y_Coord)>0) OutData%Y_Coord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y_Coord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y_Coord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y_Coord,1), UBOUND(OutData%Y_Coord,1) + OutData%Y_Coord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NumTabs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTabs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Table not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1778,6 +1749,10 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + DO I = 1, LEN(OutData%BL_file) + OutData%BL_file(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE AFI_UnPackParam SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1875,12 +1850,12 @@ SUBROUTINE AFI_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AoA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AoA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackInput SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1896,12 +1871,6 @@ SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInput' @@ -1915,12 +1884,12 @@ SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AoA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AoA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackInput SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2024,18 +1993,18 @@ SUBROUTINE AFI_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpmin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpmin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackOutput SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2051,12 +2020,6 @@ SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackOutput' @@ -2070,18 +2033,18 @@ SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpmin = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpmin = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackOutput @@ -2159,8 +2122,8 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(ReKi) :: t(2) ! Times associated with the Outputs REAL(ReKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2175,18 +2138,20 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b0 * t_out - b0 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b0 * t_out - b0 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b0 * t_out - b0 = -(y1%Cpmin - y2%Cpmin)/t(2) - y_out%Cpmin = y1%Cpmin + b0 * t_out - b0 = -(y1%Cd0 - y2%Cd0)/t(2) - y_out%Cd0 = y1%Cd0 + b0 * t_out - b0 = -(y1%Cm0 - y2%Cm0)/t(2) - y_out%Cm0 = y1%Cm0 + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%Cl - y2%Cl) + y_out%Cl = y1%Cl + b * ScaleFactor + b = -(y1%Cd - y2%Cd) + y_out%Cd = y1%Cd + b * ScaleFactor + b = -(y1%Cm - y2%Cm) + y_out%Cm = y1%Cm + b * ScaleFactor + b = -(y1%Cpmin - y2%Cpmin) + y_out%Cpmin = y1%Cpmin + b * ScaleFactor + b = -(y1%Cd0 - y2%Cd0) + y_out%Cd0 = y1%Cd0 + b * ScaleFactor + b = -(y1%Cm0 - y2%Cm0) + y_out%Cm0 = y1%Cm0 + b * ScaleFactor END SUBROUTINE AFI_Output_ExtrapInterp1 @@ -2216,8 +2181,9 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(ReKi) :: t(3) ! Times associated with the Outputs REAL(ReKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp2' @@ -2239,24 +2205,26 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cpmin = y1%Cpmin + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd0 = y1%Cd0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm0 = y1%Cm0 + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor + y_out%Cl = y1%Cl + b + c * t_out + b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor + y_out%Cd = y1%Cd + b + c * t_out + b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor + y_out%Cm = y1%Cm + b + c * t_out + b = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))* scaleFactor + c = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) * scaleFactor + y_out%Cpmin = y1%Cpmin + b + c * t_out + b = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) * scaleFactor + y_out%Cd0 = y1%Cd0 + b + c * t_out + b = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) * scaleFactor + y_out%Cm0 = y1%Cm0 + b + c * t_out END SUBROUTINE AFI_Output_ExtrapInterp2 @@ -2334,8 +2302,8 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types REAL(ReKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2350,70 +2318,72 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%alpha0 - u2%alpha0)/t(2) - u_out%alpha0 = u1%alpha0 + b0 * t_out - b0 = -(u1%alpha1 - u2%alpha1)/t(2) - u_out%alpha1 = u1%alpha1 + b0 * t_out - b0 = -(u1%alpha2 - u2%alpha2)/t(2) - u_out%alpha2 = u1%alpha2 + b0 * t_out - b0 = -(u1%eta_e - u2%eta_e)/t(2) - u_out%eta_e = u1%eta_e + b0 * t_out - b0 = -(u1%C_nalpha - u2%C_nalpha)/t(2) - u_out%C_nalpha = u1%C_nalpha + b0 * t_out - b0 = -(u1%T_f0 - u2%T_f0)/t(2) - u_out%T_f0 = u1%T_f0 + b0 * t_out - b0 = -(u1%T_V0 - u2%T_V0)/t(2) - u_out%T_V0 = u1%T_V0 + b0 * t_out - b0 = -(u1%T_p - u2%T_p)/t(2) - u_out%T_p = u1%T_p + b0 * t_out - b0 = -(u1%T_VL - u2%T_VL)/t(2) - u_out%T_VL = u1%T_VL + b0 * t_out - b0 = -(u1%b1 - u2%b1)/t(2) - u_out%b1 = u1%b1 + b0 * t_out - b0 = -(u1%b2 - u2%b2)/t(2) - u_out%b2 = u1%b2 + b0 * t_out - b0 = -(u1%b5 - u2%b5)/t(2) - u_out%b5 = u1%b5 + b0 * t_out - b0 = -(u1%A1 - u2%A1)/t(2) - u_out%A1 = u1%A1 + b0 * t_out - b0 = -(u1%A2 - u2%A2)/t(2) - u_out%A2 = u1%A2 + b0 * t_out - b0 = -(u1%A5 - u2%A5)/t(2) - u_out%A5 = u1%A5 + b0 * t_out - b0 = -(u1%S1 - u2%S1)/t(2) - u_out%S1 = u1%S1 + b0 * t_out - b0 = -(u1%S2 - u2%S2)/t(2) - u_out%S2 = u1%S2 + b0 * t_out - b0 = -(u1%S3 - u2%S3)/t(2) - u_out%S3 = u1%S3 + b0 * t_out - b0 = -(u1%S4 - u2%S4)/t(2) - u_out%S4 = u1%S4 + b0 * t_out - b0 = -(u1%Cn1 - u2%Cn1)/t(2) - u_out%Cn1 = u1%Cn1 + b0 * t_out - b0 = -(u1%Cn2 - u2%Cn2)/t(2) - u_out%Cn2 = u1%Cn2 + b0 * t_out - b0 = -(u1%St_sh - u2%St_sh)/t(2) - u_out%St_sh = u1%St_sh + b0 * t_out - b0 = -(u1%Cd0 - u2%Cd0)/t(2) - u_out%Cd0 = u1%Cd0 + b0 * t_out - b0 = -(u1%Cm0 - u2%Cm0)/t(2) - u_out%Cm0 = u1%Cm0 + b0 * t_out - b0 = -(u1%k0 - u2%k0)/t(2) - u_out%k0 = u1%k0 + b0 * t_out - b0 = -(u1%k1 - u2%k1)/t(2) - u_out%k1 = u1%k1 + b0 * t_out - b0 = -(u1%k2 - u2%k2)/t(2) - u_out%k2 = u1%k2 + b0 * t_out - b0 = -(u1%k3 - u2%k3)/t(2) - u_out%k3 = u1%k3 + b0 * t_out - b0 = -(u1%k1_hat - u2%k1_hat)/t(2) - u_out%k1_hat = u1%k1_hat + b0 * t_out - b0 = -(u1%x_cp_bar - u2%x_cp_bar)/t(2) - u_out%x_cp_bar = u1%x_cp_bar + b0 * t_out - b0 = -(u1%UACutout - u2%UACutout)/t(2) - u_out%UACutout = u1%UACutout + b0 * t_out - b0 = -(u1%filtCutOff - u2%filtCutOff)/t(2) - u_out%filtCutOff = u1%filtCutOff + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%alpha0 - u2%alpha0) + u_out%alpha0 = u1%alpha0 + b * ScaleFactor + b = -(u1%alpha1 - u2%alpha1) + u_out%alpha1 = u1%alpha1 + b * ScaleFactor + b = -(u1%alpha2 - u2%alpha2) + u_out%alpha2 = u1%alpha2 + b * ScaleFactor + b = -(u1%eta_e - u2%eta_e) + u_out%eta_e = u1%eta_e + b * ScaleFactor + b = -(u1%C_nalpha - u2%C_nalpha) + u_out%C_nalpha = u1%C_nalpha + b * ScaleFactor + b = -(u1%T_f0 - u2%T_f0) + u_out%T_f0 = u1%T_f0 + b * ScaleFactor + b = -(u1%T_V0 - u2%T_V0) + u_out%T_V0 = u1%T_V0 + b * ScaleFactor + b = -(u1%T_p - u2%T_p) + u_out%T_p = u1%T_p + b * ScaleFactor + b = -(u1%T_VL - u2%T_VL) + u_out%T_VL = u1%T_VL + b * ScaleFactor + b = -(u1%b1 - u2%b1) + u_out%b1 = u1%b1 + b * ScaleFactor + b = -(u1%b2 - u2%b2) + u_out%b2 = u1%b2 + b * ScaleFactor + b = -(u1%b5 - u2%b5) + u_out%b5 = u1%b5 + b * ScaleFactor + b = -(u1%A1 - u2%A1) + u_out%A1 = u1%A1 + b * ScaleFactor + b = -(u1%A2 - u2%A2) + u_out%A2 = u1%A2 + b * ScaleFactor + b = -(u1%A5 - u2%A5) + u_out%A5 = u1%A5 + b * ScaleFactor + b = -(u1%S1 - u2%S1) + u_out%S1 = u1%S1 + b * ScaleFactor + b = -(u1%S2 - u2%S2) + u_out%S2 = u1%S2 + b * ScaleFactor + b = -(u1%S3 - u2%S3) + u_out%S3 = u1%S3 + b * ScaleFactor + b = -(u1%S4 - u2%S4) + u_out%S4 = u1%S4 + b * ScaleFactor + b = -(u1%Cn1 - u2%Cn1) + u_out%Cn1 = u1%Cn1 + b * ScaleFactor + b = -(u1%Cn2 - u2%Cn2) + u_out%Cn2 = u1%Cn2 + b * ScaleFactor + b = -(u1%St_sh - u2%St_sh) + u_out%St_sh = u1%St_sh + b * ScaleFactor + b = -(u1%Cd0 - u2%Cd0) + u_out%Cd0 = u1%Cd0 + b * ScaleFactor + b = -(u1%Cm0 - u2%Cm0) + u_out%Cm0 = u1%Cm0 + b * ScaleFactor + b = -(u1%k0 - u2%k0) + u_out%k0 = u1%k0 + b * ScaleFactor + b = -(u1%k1 - u2%k1) + u_out%k1 = u1%k1 + b * ScaleFactor + b = -(u1%k2 - u2%k2) + u_out%k2 = u1%k2 + b * ScaleFactor + b = -(u1%k3 - u2%k3) + u_out%k3 = u1%k3 + b * ScaleFactor + b = -(u1%k1_hat - u2%k1_hat) + u_out%k1_hat = u1%k1_hat + b * ScaleFactor + b = -(u1%x_cp_bar - u2%x_cp_bar) + u_out%x_cp_bar = u1%x_cp_bar + b * ScaleFactor + b = -(u1%UACutout - u2%UACutout) + u_out%UACutout = u1%UACutout + b * ScaleFactor + b = -(u1%filtCutOff - u2%filtCutOff) + u_out%filtCutOff = u1%filtCutOff + b * ScaleFactor END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1 @@ -2443,8 +2413,9 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types REAL(ReKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp2' @@ -2466,102 +2437,104 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%alpha0 - u2%alpha0) + t(2)**2*(-u1%alpha0 + u3%alpha0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha0 + t(3)*u2%alpha0 - t(2)*u3%alpha0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha0 = u1%alpha0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha1 - u2%alpha1) + t(2)**2*(-u1%alpha1 + u3%alpha1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha1 + t(3)*u2%alpha1 - t(2)*u3%alpha1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha1 = u1%alpha1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha2 - u2%alpha2) + t(2)**2*(-u1%alpha2 + u3%alpha2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha2 + t(3)*u2%alpha2 - t(2)*u3%alpha2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha2 = u1%alpha2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%eta_e = u1%eta_e + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%C_nalpha = u1%C_nalpha + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_f0 = u1%T_f0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_V0 = u1%T_V0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_p = u1%T_p + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_VL = u1%T_VL + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b1 = u1%b1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b2 = u1%b2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b5 = u1%b5 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A1 = u1%A1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A2 = u1%A2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A5 = u1%A5 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S1 = u1%S1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S2 = u1%S2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S3 = u1%S3 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S4 = u1%S4 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cn1 = u1%Cn1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cn2 = u1%Cn2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%St_sh = u1%St_sh + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cd0 = u1%Cd0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cm0 = u1%Cm0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k0 = u1%k0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k1 = u1%k1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k2 = u1%k2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k3 = u1%k3 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k1_hat = u1%k1_hat + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%x_cp_bar = u1%x_cp_bar + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UACutout = u1%UACutout + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%filtCutOff = u1%filtCutOff + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%alpha0 - u2%alpha0) + t(2)**2*(-u1%alpha0 + u3%alpha0))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha0 + t(3)*u2%alpha0 - t(2)*u3%alpha0 ) * scaleFactor + u_out%alpha0 = u1%alpha0 + b + c * t_out + b = (t(3)**2*(u1%alpha1 - u2%alpha1) + t(2)**2*(-u1%alpha1 + u3%alpha1))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha1 + t(3)*u2%alpha1 - t(2)*u3%alpha1 ) * scaleFactor + u_out%alpha1 = u1%alpha1 + b + c * t_out + b = (t(3)**2*(u1%alpha2 - u2%alpha2) + t(2)**2*(-u1%alpha2 + u3%alpha2))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha2 + t(3)*u2%alpha2 - t(2)*u3%alpha2 ) * scaleFactor + u_out%alpha2 = u1%alpha2 + b + c * t_out + b = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))* scaleFactor + c = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) * scaleFactor + u_out%eta_e = u1%eta_e + b + c * t_out + b = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))* scaleFactor + c = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) * scaleFactor + u_out%C_nalpha = u1%C_nalpha + b + c * t_out + b = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))* scaleFactor + c = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) * scaleFactor + u_out%T_f0 = u1%T_f0 + b + c * t_out + b = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))* scaleFactor + c = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) * scaleFactor + u_out%T_V0 = u1%T_V0 + b + c * t_out + b = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))* scaleFactor + c = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) * scaleFactor + u_out%T_p = u1%T_p + b + c * t_out + b = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))* scaleFactor + c = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) * scaleFactor + u_out%T_VL = u1%T_VL + b + c * t_out + b = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))* scaleFactor + c = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) * scaleFactor + u_out%b1 = u1%b1 + b + c * t_out + b = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))* scaleFactor + c = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) * scaleFactor + u_out%b2 = u1%b2 + b + c * t_out + b = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))* scaleFactor + c = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) * scaleFactor + u_out%b5 = u1%b5 + b + c * t_out + b = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))* scaleFactor + c = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) * scaleFactor + u_out%A1 = u1%A1 + b + c * t_out + b = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))* scaleFactor + c = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) * scaleFactor + u_out%A2 = u1%A2 + b + c * t_out + b = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))* scaleFactor + c = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) * scaleFactor + u_out%A5 = u1%A5 + b + c * t_out + b = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))* scaleFactor + c = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) * scaleFactor + u_out%S1 = u1%S1 + b + c * t_out + b = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))* scaleFactor + c = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) * scaleFactor + u_out%S2 = u1%S2 + b + c * t_out + b = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))* scaleFactor + c = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) * scaleFactor + u_out%S3 = u1%S3 + b + c * t_out + b = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))* scaleFactor + c = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) * scaleFactor + u_out%S4 = u1%S4 + b + c * t_out + b = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))* scaleFactor + c = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) * scaleFactor + u_out%Cn1 = u1%Cn1 + b + c * t_out + b = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))* scaleFactor + c = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) * scaleFactor + u_out%Cn2 = u1%Cn2 + b + c * t_out + b = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))* scaleFactor + c = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) * scaleFactor + u_out%St_sh = u1%St_sh + b + c * t_out + b = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))* scaleFactor + c = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) * scaleFactor + u_out%Cd0 = u1%Cd0 + b + c * t_out + b = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))* scaleFactor + c = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) * scaleFactor + u_out%Cm0 = u1%Cm0 + b + c * t_out + b = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))* scaleFactor + c = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) * scaleFactor + u_out%k0 = u1%k0 + b + c * t_out + b = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))* scaleFactor + c = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) * scaleFactor + u_out%k1 = u1%k1 + b + c * t_out + b = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))* scaleFactor + c = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) * scaleFactor + u_out%k2 = u1%k2 + b + c * t_out + b = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))* scaleFactor + c = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) * scaleFactor + u_out%k3 = u1%k3 + b + c * t_out + b = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))* scaleFactor + c = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) * scaleFactor + u_out%k1_hat = u1%k1_hat + b + c * t_out + b = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))* scaleFactor + c = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) * scaleFactor + u_out%x_cp_bar = u1%x_cp_bar + b + c * t_out + b = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))* scaleFactor + c = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) * scaleFactor + u_out%UACutout = u1%UACutout + b + c * t_out + b = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))* scaleFactor + c = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) * scaleFactor + u_out%filtCutOff = u1%filtCutOff + b + c * t_out END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2 END MODULE AirfoilInfo_Types diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index eb5f8b9681..8f9efbd62c 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -431,21 +431,6 @@ subroutine BEMT_AllocOutput( y, p, errStat, errMsg ) end subroutine BEMT_AllocOutput - -subroutine BEMT_MapOutputs(p, OtherState, y, errStat, errMsg) - - type(BEMT_ParameterType), intent(in ) :: p ! Parameters - type(BEMT_OtherStateType), intent(in ) :: OtherState ! other states - type(BEMT_OutputType), intent(inout) :: y ! system outputs - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMsg = "" - -end subroutine BEMT_MapOutputs - - !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Interval, InitOut, ErrStat, ErrMsg ) ! This routine is called at the start of the simulation to perform initialization steps. @@ -464,7 +449,7 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte type(AFI_ParameterType), intent(in ) :: AFInfo(:) ! The airfoil parameter data type(BEMT_OutputType), intent( out) :: y ! Initial system outputs (outputs are not calculated; ! only the output mesh is initialized) - real(DbKi), intent(inout) :: interval ! Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval ! Coupling interval in seconds: the rate that ! (1) BEMT_UpdateStates() is called in loose coupling & ! (2) BEMT_UpdateDiscState() is called in tight coupling. ! Input is the suggested time from the glue code; @@ -568,6 +553,8 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte call cleanup() return end if + p%UA%ShedEffect=.True. ! This should be true when coupled to BEM. True in registry as default. + call BEMT_CheckInitUA(p, OtherState, AFInfo, ErrStat2, ErrMsg2) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -647,25 +634,6 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte call AllocAry(misc%TanInduction,p%numBladeNodes,p%numBlades,'misc%TanInduction', errStat2,errMsg2); call SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) call AllocAry(misc%Rtip,p%numBlades,'misc%Rtip', errStat2,errMsg2); call SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) - !............................................................................................ - ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which - ! this module must be called here: - !............................................................................................ - - Interval = p%DT - - - ! Print the summary file if requested: - !IF (InputFileData%SumPrint) THEN - ! CALL BEMT_PrintSum( p, OtherState, GetAdamsVals, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - !END IF - - ! Destroy the InputFileData structure (deallocate arrays) - - !CALL BEMT_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CONTAINS !............................................................................................................................... SUBROUTINE Cleanup() @@ -1198,12 +1166,6 @@ end subroutine calculate_Inductions_from_DBEMT !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat, errMsg ) ! Routine for computing outputs, used in both loose and tight coupling. -! This SUBROUTINE is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. -! NOTE: the descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for -! for a complete description of each output parameter. -! NOTE: no matter how many channels are selected for output, all of the outputs are calculated -! All of the calculated output channels are placed into the OtherState%AllOuts(:), while the channels selected for outputs are -! placed in the y%WriteOutput(:) array. !.................................................................................................................................. @@ -1241,7 +1203,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat integer(IntKi) :: k #endif - logical, parameter :: UpdateValues = .TRUE. ! determines if the OtherState values need to be updated logical :: IsValidSolution !< this is set to false if k<=1 in propeller brake region or k<-1 in momentum region, indicating an invalid solution ! Initialize some output values errStat = ErrID_None @@ -1305,16 +1266,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat end if end if - ! Array OtherState%AllOuts() is initialized to 0.0 in initialization, so we are not going to reinitialize it here. - - - !............................................................................................................................... - ! Calculate all of the total forces and moments using all of the partial forces and moments calculated in RtHS(). Also, - ! calculate all of the total angular and linear accelerations using all of the partial accelerations calculated in RtHS(). - ! To do this, first initialize the variables using the portions not associated with the accelerations. Then add the portions - ! associated with the accelerations one by one: - !............................................................................................................................... - do j = 1,p%numBlades ! Loop through all blades ! Locate the maximum rlocal value for this time step and this blade. This is passed to the solve as Rtip @@ -1424,29 +1375,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat ! end if #endif - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - call BEMT_MapOutputs(p, OtherState, y, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (errStat >= AbortErrLev) return - - !DO I = 1,p%NumOuts ! Loop through all selected output channels - ! - ! y%WriteOutput(I) = p%OutParam(I)%SignM * OtherState%AllOuts( p%OutParam(I)%Indx ) - ! - !ENDDO ! I - All selected output channels - - - !............................................................................................................................... - ! Outputs required for AeroDyn - !............................................................................................................................... - - !........... - ! Blade elements: - !........... - return @@ -2122,4 +2050,4 @@ function NodeText(i,j) end function NodeText end module BEMT - \ No newline at end of file + diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 5388d79a12..a5450d6eb5 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -446,37 +446,41 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chord))-1 ) = PACK(InData%chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chord) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useHubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useInduction , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useAIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) + DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) + ReKiBuf(Re_Xferred) = InData%chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%airDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%skewWakeMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%aTol + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBladeNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numReIterations + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%maxIndIterations + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -490,8 +494,12 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFindx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AFindx))-1 ) = PACK(InData%AFindx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AFindx) + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zHub) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -503,8 +511,10 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zHub)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zHub))-1 ) = PACK(InData%zHub,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zHub) + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%zLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -519,8 +529,12 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zLocal))-1 ) = PACK(InData%zLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zLocal) + DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) + DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) + ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zTip) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -532,8 +546,10 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zTip)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zTip))-1 ) = PACK(InData%zTip,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zTip) + DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) + ReKiBuf(Re_Xferred) = InData%zTip(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -548,23 +564,27 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UA_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawCorrFactor + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_PackInitInput SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -580,12 +600,6 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -617,44 +631,41 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chord)>0) OutData%chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chord) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) + DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) + OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%airDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%skewWakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) + Int_Xferred = Int_Xferred + 1 + OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) + Int_Xferred = Int_Xferred + 1 + OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%numBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numReIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%maxIndIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -671,15 +682,12 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFindx)>0) OutData%AFindx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AFindx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AFindx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated Int_Xferred = Int_Xferred + 1 @@ -694,15 +702,10 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zHub)>0) OutData%zHub = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zHub))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zHub) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -720,15 +723,12 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%zLocal)>0) OutData%zLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zLocal) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) + DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) + OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip not allocated Int_Xferred = Int_Xferred + 1 @@ -743,15 +743,10 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zTip)>0) OutData%zTip = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zTip))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zTip) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) + OutData%zTip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -769,30 +764,27 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) - END IF - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yawCorrFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_UnPackInitInput SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -949,12 +941,6 @@ SUBROUTINE BEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInitOutput' @@ -1123,8 +1109,8 @@ SUBROUTINE BEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1168,12 +1154,6 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackContState' @@ -1187,8 +1167,8 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1385,12 +1365,6 @@ SUBROUTINE BEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackDiscState' @@ -1572,8 +1546,12 @@ SUBROUTINE BEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackConstrState @@ -1590,12 +1568,6 @@ SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1627,15 +1599,12 @@ SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackConstrState @@ -1888,8 +1857,12 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_Flag,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UA_Flag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%UA_Flag)-1 ) = TRANSFER(PACK( InData%UA_Flag ,.TRUE.), IntKiBuf(1), SIZE(InData%UA_Flag)) - Int_Xferred = Int_Xferred + SIZE(InData%UA_Flag) + DO i2 = LBOUND(InData%UA_Flag,2), UBOUND(InData%UA_Flag,2) + DO i1 = LBOUND(InData%UA_Flag,1), UBOUND(InData%UA_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ValidPhi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1904,11 +1877,15 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ValidPhi)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ValidPhi)-1 ) = TRANSFER(PACK( InData%ValidPhi ,.TRUE.), IntKiBuf(1), SIZE(InData%ValidPhi)) - Int_Xferred = Int_Xferred + SIZE(InData%ValidPhi) + DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) + DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%nodesInitialized , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_PackOtherState SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1924,12 +1901,6 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2041,15 +2012,12 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_Flag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UA_Flag)>0) OutData%UA_Flag = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%UA_Flag))-1 ), OutData%UA_Flag), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%UA_Flag) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UA_Flag,2), UBOUND(OutData%UA_Flag,2) + DO i1 = LBOUND(OutData%UA_Flag,1), UBOUND(OutData%UA_Flag,1) + OutData%UA_Flag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi not allocated Int_Xferred = Int_Xferred + 1 @@ -2067,18 +2035,15 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ValidPhi)>0) OutData%ValidPhi = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ValidPhi))-1 ), OutData%ValidPhi), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ValidPhi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) + DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) + OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%nodesInitialized = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_UnPackOtherState SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2350,10 +2315,10 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_Skew , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_Phi , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Skew, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Phi, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2451,8 +2416,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TnInd_op)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TnInd_op))-1 ) = PACK(InData%TnInd_op,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TnInd_op) + DO i2 = LBOUND(InData%TnInd_op,2), UBOUND(InData%TnInd_op,2) + DO i1 = LBOUND(InData%TnInd_op,1), UBOUND(InData%TnInd_op,1) + ReKiBuf(Re_Xferred) = InData%TnInd_op(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxInd_op) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2467,8 +2436,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxInd_op)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxInd_op))-1 ) = PACK(InData%AxInd_op,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxInd_op) + DO i2 = LBOUND(InData%AxInd_op,2), UBOUND(InData%AxInd_op,2) + DO i1 = LBOUND(InData%AxInd_op,1), UBOUND(InData%AxInd_op,1) + ReKiBuf(Re_Xferred) = InData%AxInd_op(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2483,8 +2456,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxInduction))-1 ) = PACK(InData%AxInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxInduction) + DO i2 = LBOUND(InData%AxInduction,2), UBOUND(InData%AxInduction,2) + DO i1 = LBOUND(InData%AxInduction,1), UBOUND(InData%AxInduction,1) + ReKiBuf(Re_Xferred) = InData%AxInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TanInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2499,11 +2476,15 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TanInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TanInduction))-1 ) = PACK(InData%TanInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TanInduction) + DO i2 = LBOUND(InData%TanInduction,2), UBOUND(InData%TanInduction,2) + DO i1 = LBOUND(InData%TanInduction,1), UBOUND(InData%TanInduction,1) + ReKiBuf(Re_Xferred) = InData%TanInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseFrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseFrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Rtip) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2514,8 +2495,10 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rtip,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Rtip)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Rtip))-1 ) = PACK(InData%Rtip,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Rtip) + DO i1 = LBOUND(InData%Rtip,1), UBOUND(InData%Rtip,1) + ReKiBuf(Re_Xferred) = InData%Rtip(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BEMT_PackMisc @@ -2532,12 +2515,6 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2553,10 +2530,10 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_Skew = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_Phi = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Skew) + Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_Phi = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Phi) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2693,15 +2670,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TnInd_op)>0) OutData%TnInd_op = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TnInd_op))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TnInd_op) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TnInd_op,2), UBOUND(OutData%TnInd_op,2) + DO i1 = LBOUND(OutData%TnInd_op,1), UBOUND(OutData%TnInd_op,1) + OutData%TnInd_op(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInd_op not allocated Int_Xferred = Int_Xferred + 1 @@ -2719,15 +2693,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AxInd_op)>0) OutData%AxInd_op = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxInd_op))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxInd_op) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AxInd_op,2), UBOUND(OutData%AxInd_op,2) + DO i1 = LBOUND(OutData%AxInd_op,1), UBOUND(OutData%AxInd_op,1) + OutData%AxInd_op(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -2745,15 +2716,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AxInduction)>0) OutData%AxInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AxInduction,2), UBOUND(OutData%AxInduction,2) + DO i1 = LBOUND(OutData%AxInduction,1), UBOUND(OutData%AxInduction,1) + OutData%AxInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TanInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -2771,18 +2739,15 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TanInduction)>0) OutData%TanInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TanInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TanInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TanInduction,2), UBOUND(OutData%TanInduction,2) + DO i1 = LBOUND(OutData%TanInduction,1), UBOUND(OutData%TanInduction,1) + OutData%TanInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%UseFrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UseFrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseFrozenWake) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rtip not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2796,15 +2761,10 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Rtip)>0) OutData%Rtip = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Rtip))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Rtip) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Rtip,1), UBOUND(OutData%Rtip,1) + OutData%Rtip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BEMT_UnPackMisc @@ -3086,8 +3046,8 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%chord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3101,37 +3061,41 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chord))-1 ) = PACK(InData%chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chord) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useHubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useInduction , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useAIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) + DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) + ReKiBuf(Re_Xferred) = InData%chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%airDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%skewWakeMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%aTol + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBladeNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numReIterations + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%maxIndIterations + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3145,8 +3109,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFindx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AFindx))-1 ) = PACK(InData%AFindx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AFindx) + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tipLossConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3161,8 +3129,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tipLossConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tipLossConst))-1 ) = PACK(InData%tipLossConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tipLossConst) + DO i2 = LBOUND(InData%tipLossConst,2), UBOUND(InData%tipLossConst,2) + DO i1 = LBOUND(InData%tipLossConst,1), UBOUND(InData%tipLossConst,1) + ReKiBuf(Re_Xferred) = InData%tipLossConst(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%hubLossConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3177,8 +3149,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%hubLossConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%hubLossConst))-1 ) = PACK(InData%hubLossConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%hubLossConst) + DO i2 = LBOUND(InData%hubLossConst,2), UBOUND(InData%hubLossConst,2) + DO i1 = LBOUND(InData%hubLossConst,1), UBOUND(InData%hubLossConst,1) + ReKiBuf(Re_Xferred) = InData%hubLossConst(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zHub) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3190,8 +3166,10 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zHub)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zHub))-1 ) = PACK(InData%zHub,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zHub) + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3249,12 +3227,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UA_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawCorrFactor + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_PackParam SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3270,12 +3248,6 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3291,8 +3263,8 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3309,44 +3281,41 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chord)>0) OutData%chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chord) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) + DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) + OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%airDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%skewWakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) + Int_Xferred = Int_Xferred + 1 + OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) + Int_Xferred = Int_Xferred + 1 + OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%numBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numReIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%maxIndIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3363,15 +3332,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFindx)>0) OutData%AFindx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AFindx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AFindx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tipLossConst not allocated Int_Xferred = Int_Xferred + 1 @@ -3389,15 +3355,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tipLossConst)>0) OutData%tipLossConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tipLossConst))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tipLossConst) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tipLossConst,2), UBOUND(OutData%tipLossConst,2) + DO i1 = LBOUND(OutData%tipLossConst,1), UBOUND(OutData%tipLossConst,1) + OutData%tipLossConst(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubLossConst not allocated Int_Xferred = Int_Xferred + 1 @@ -3415,15 +3378,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%hubLossConst)>0) OutData%hubLossConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%hubLossConst))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%hubLossConst) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%hubLossConst,2), UBOUND(OutData%hubLossConst,2) + DO i1 = LBOUND(OutData%hubLossConst,1), UBOUND(OutData%hubLossConst,1) + OutData%hubLossConst(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated Int_Xferred = Int_Xferred + 1 @@ -3438,15 +3398,10 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zHub)>0) OutData%zHub = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zHub))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zHub) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3528,12 +3483,12 @@ SUBROUTINE BEMT_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) - OutData%UA_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%yawCorrFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_UnPackParam SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3776,11 +3731,15 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%theta)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%theta))-1 ) = PACK(InData%theta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%theta) + DO i2 = LBOUND(InData%theta,2), UBOUND(InData%theta,2) + DO i1 = LBOUND(InData%theta,1), UBOUND(InData%theta,1) + ReKiBuf(Re_Xferred) = InData%theta(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%chi0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%chi0 + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%psi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3791,11 +3750,13 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%psi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%psi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%psi))-1 ) = PACK(InData%psi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%psi) + DO i1 = LBOUND(InData%psi,1), UBOUND(InData%psi,1) + ReKiBuf(Re_Xferred) = InData%psi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%omega - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%omega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Vx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3809,8 +3770,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vx))-1 ) = PACK(InData%Vx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vx) + DO i2 = LBOUND(InData%Vx,2), UBOUND(InData%Vx,2) + DO i1 = LBOUND(InData%Vx,1), UBOUND(InData%Vx,1) + ReKiBuf(Re_Xferred) = InData%Vx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Vy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3825,8 +3790,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vy))-1 ) = PACK(InData%Vy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vy) + DO i2 = LBOUND(InData%Vy,2), UBOUND(InData%Vy,2) + DO i1 = LBOUND(InData%Vy,1), UBOUND(InData%Vy,1) + ReKiBuf(Re_Xferred) = InData%Vy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3841,11 +3810,15 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Un_disk + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3859,8 +3832,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UserProp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UserProp))-1 ) = PACK(InData%UserProp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UserProp) + DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) + DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) + ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackInput @@ -3877,12 +3854,6 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3914,18 +3885,15 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%theta)>0) OutData%theta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%theta))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%theta) - DEALLOCATE(mask2) - END IF - OutData%chi0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%theta,2), UBOUND(OutData%theta,2) + DO i1 = LBOUND(OutData%theta,1), UBOUND(OutData%theta,1) + OutData%theta(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%chi0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3939,18 +3907,13 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%psi)>0) OutData%psi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%psi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%psi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%psi,1), UBOUND(OutData%psi,1) + OutData%psi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%omega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%omega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3967,15 +3930,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vx)>0) OutData%Vx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vx))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vx,2), UBOUND(OutData%Vx,2) + DO i1 = LBOUND(OutData%Vx,1), UBOUND(OutData%Vx,1) + OutData%Vx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy not allocated Int_Xferred = Int_Xferred + 1 @@ -3993,15 +3953,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vy)>0) OutData%Vy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vy))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vy) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vy,2), UBOUND(OutData%Vy,2) + DO i1 = LBOUND(OutData%Vy,1), UBOUND(OutData%Vy,1) + OutData%Vy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -4019,18 +3976,15 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) - END IF - OutData%Un_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%Un_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4047,15 +4001,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UserProp)>0) OutData%UserProp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UserProp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UserProp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) + DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) + OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackInput @@ -4449,8 +4400,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vrel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vrel))-1 ) = PACK(InData%Vrel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vrel) + DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) + DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) + ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%phi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4465,8 +4420,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%axInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4481,8 +4440,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%axInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%axInduction))-1 ) = PACK(InData%axInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%axInduction) + DO i2 = LBOUND(InData%axInduction,2), UBOUND(InData%axInduction,2) + DO i1 = LBOUND(InData%axInduction,1), UBOUND(InData%axInduction,1) + ReKiBuf(Re_Xferred) = InData%axInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tanInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4497,8 +4460,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tanInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tanInduction))-1 ) = PACK(InData%tanInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tanInduction) + DO i2 = LBOUND(InData%tanInduction,2), UBOUND(InData%tanInduction,2) + DO i1 = LBOUND(InData%tanInduction,1), UBOUND(InData%tanInduction,1) + ReKiBuf(Re_Xferred) = InData%tanInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Re) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4513,8 +4480,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Re)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Re))-1 ) = PACK(InData%Re,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Re) + DO i2 = LBOUND(InData%Re,2), UBOUND(InData%Re,2) + DO i1 = LBOUND(InData%Re,1), UBOUND(InData%Re,1) + ReKiBuf(Re_Xferred) = InData%Re(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4529,8 +4500,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOA))-1 ) = PACK(InData%AOA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOA) + DO i2 = LBOUND(InData%AOA,2), UBOUND(InData%AOA,2) + DO i1 = LBOUND(InData%AOA,1), UBOUND(InData%AOA,1) + ReKiBuf(Re_Xferred) = InData%AOA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4545,8 +4520,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cx))-1 ) = PACK(InData%Cx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cx) + DO i2 = LBOUND(InData%Cx,2), UBOUND(InData%Cx,2) + DO i1 = LBOUND(InData%Cx,1), UBOUND(InData%Cx,1) + ReKiBuf(Re_Xferred) = InData%Cx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4561,8 +4540,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cy))-1 ) = PACK(InData%Cy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cy) + DO i2 = LBOUND(InData%Cy,2), UBOUND(InData%Cy,2) + DO i1 = LBOUND(InData%Cy,1), UBOUND(InData%Cy,1) + ReKiBuf(Re_Xferred) = InData%Cy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4577,8 +4560,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cm))-1 ) = PACK(InData%Cm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cm) + DO i2 = LBOUND(InData%Cm,2), UBOUND(InData%Cm,2) + DO i1 = LBOUND(InData%Cm,1), UBOUND(InData%Cm,1) + ReKiBuf(Re_Xferred) = InData%Cm(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4593,8 +4580,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cl))-1 ) = PACK(InData%Cl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cl) + DO i2 = LBOUND(InData%Cl,2), UBOUND(InData%Cl,2) + DO i1 = LBOUND(InData%Cl,1), UBOUND(InData%Cl,1) + ReKiBuf(Re_Xferred) = InData%Cl(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4609,8 +4600,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cd))-1 ) = PACK(InData%Cd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cd) + DO i2 = LBOUND(InData%Cd,2), UBOUND(InData%Cd,2) + DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) + ReKiBuf(Re_Xferred) = InData%Cd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%chi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4625,8 +4620,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chi))-1 ) = PACK(InData%chi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chi) + DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) + DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) + ReKiBuf(Re_Xferred) = InData%chi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cpmin) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4641,8 +4640,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cpmin)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cpmin))-1 ) = PACK(InData%Cpmin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cpmin) + DO i2 = LBOUND(InData%Cpmin,2), UBOUND(InData%Cpmin,2) + DO i1 = LBOUND(InData%Cpmin,1), UBOUND(InData%Cpmin,1) + ReKiBuf(Re_Xferred) = InData%Cpmin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackOutput @@ -4659,12 +4662,6 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4696,15 +4693,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vrel)>0) OutData%Vrel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vrel))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vrel) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) + DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) + OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated Int_Xferred = Int_Xferred + 1 @@ -4722,15 +4716,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -4748,15 +4739,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%axInduction)>0) OutData%axInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%axInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%axInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%axInduction,2), UBOUND(OutData%axInduction,2) + DO i1 = LBOUND(OutData%axInduction,1), UBOUND(OutData%axInduction,1) + OutData%axInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -4774,15 +4762,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tanInduction)>0) OutData%tanInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tanInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tanInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tanInduction,2), UBOUND(OutData%tanInduction,2) + DO i1 = LBOUND(OutData%tanInduction,1), UBOUND(OutData%tanInduction,1) + OutData%tanInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Re not allocated Int_Xferred = Int_Xferred + 1 @@ -4800,15 +4785,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Re)>0) OutData%Re = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Re))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Re) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Re,2), UBOUND(OutData%Re,2) + DO i1 = LBOUND(OutData%Re,1), UBOUND(OutData%Re,1) + OutData%Re(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOA not allocated Int_Xferred = Int_Xferred + 1 @@ -4826,15 +4808,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOA)>0) OutData%AOA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOA,2), UBOUND(OutData%AOA,2) + DO i1 = LBOUND(OutData%AOA,1), UBOUND(OutData%AOA,1) + OutData%AOA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cx not allocated Int_Xferred = Int_Xferred + 1 @@ -4852,15 +4831,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cx)>0) OutData%Cx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cx))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cx,2), UBOUND(OutData%Cx,2) + DO i1 = LBOUND(OutData%Cx,1), UBOUND(OutData%Cx,1) + OutData%Cx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cy not allocated Int_Xferred = Int_Xferred + 1 @@ -4878,15 +4854,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cy)>0) OutData%Cy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cy))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cy) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cy,2), UBOUND(OutData%Cy,2) + DO i1 = LBOUND(OutData%Cy,1), UBOUND(OutData%Cy,1) + OutData%Cy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm not allocated Int_Xferred = Int_Xferred + 1 @@ -4904,15 +4877,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cm)>0) OutData%Cm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cm))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cm) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cm,2), UBOUND(OutData%Cm,2) + DO i1 = LBOUND(OutData%Cm,1), UBOUND(OutData%Cm,1) + OutData%Cm(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl not allocated Int_Xferred = Int_Xferred + 1 @@ -4930,15 +4900,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cl)>0) OutData%Cl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cl))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cl) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cl,2), UBOUND(OutData%Cl,2) + DO i1 = LBOUND(OutData%Cl,1), UBOUND(OutData%Cl,1) + OutData%Cl(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated Int_Xferred = Int_Xferred + 1 @@ -4956,15 +4923,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cd)>0) OutData%Cd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cd))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cd) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cd,2), UBOUND(OutData%Cd,2) + DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) + OutData%Cd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated Int_Xferred = Int_Xferred + 1 @@ -4982,15 +4946,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chi)>0) OutData%chi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) + DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) + OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cpmin not allocated Int_Xferred = Int_Xferred + 1 @@ -5008,15 +4969,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cpmin)>0) OutData%Cpmin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cpmin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cpmin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cpmin,2), UBOUND(OutData%Cpmin,2) + DO i1 = LBOUND(OutData%Cpmin,1), UBOUND(OutData%Cpmin,1) + OutData%Cpmin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackOutput @@ -5095,14 +5053,14 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5115,59 +5073,59 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - ALLOCATE(b2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - ALLOCATE(c2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - b2 = -(u1%theta - u2%theta)/t(2) - u_out%theta = u1%theta + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) + DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) + b = -(u1%theta(i1,i2) - u2%theta(i1,i2)) + u_out%theta(i1,i2) = u1%theta(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(u1%chi0 - u2%chi0)/t(2) - u_out%chi0 = u1%chi0 + b0 * t_out + b = -(u1%chi0 - u2%chi0) + u_out%chi0 = u1%chi0 + b * ScaleFactor IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - ALLOCATE(b1(SIZE(u_out%psi,1))) - ALLOCATE(c1(SIZE(u_out%psi,1))) - b1 = -(u1%psi - u2%psi)/t(2) - u_out%psi = u1%psi + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) + b = -(u1%psi(i1) - u2%psi(i1)) + u_out%psi(i1) = u1%psi(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(u1%omega - u2%omega)/t(2) - u_out%omega = u1%omega + b0 * t_out + b = -(u1%omega - u2%omega) + u_out%omega = u1%omega + b * ScaleFactor IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - ALLOCATE(b2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - ALLOCATE(c2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - b2 = -(u1%Vx - u2%Vx)/t(2) - u_out%Vx = u1%Vx + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) + DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) + b = -(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - ALLOCATE(b2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - ALLOCATE(c2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - b2 = -(u1%Vy - u2%Vy)/t(2) - u_out%Vy = u1%Vy + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) + DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) + b = -(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - ALLOCATE(b2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - ALLOCATE(c2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - b2 = -(u1%rLocal - u2%rLocal)/t(2) - u_out%rLocal = u1%rLocal + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) + DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) + b = -(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(u1%Un_disk - u2%Un_disk)/t(2) - u_out%Un_disk = u1%Un_disk + b0 * t_out + b = -(u1%Un_disk - u2%Un_disk) + u_out%Un_disk = u1%Un_disk + b * ScaleFactor IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp1 @@ -5198,15 +5156,16 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5225,68 +5184,68 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - ALLOCATE(b2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - ALLOCATE(c2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - b2 = (t(3)**2*(u1%theta - u2%theta) + t(2)**2*(-u1%theta + u3%theta))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%theta + t(3)*u2%theta - t(2)*u3%theta ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%theta = u1%theta + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) + DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) + b = (t(3)**2*(u1%theta(i1,i2) - u2%theta(i1,i2)) + t(2)**2*(-u1%theta(i1,i2) + u3%theta(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%theta(i1,i2) + t(3)*u2%theta(i1,i2) - t(2)*u3%theta(i1,i2) ) * scaleFactor + u_out%theta(i1,i2) = u1%theta(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%chi0 = u1%chi0 + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor + c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor + u_out%chi0 = u1%chi0 + b + c * t_out IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - ALLOCATE(b1(SIZE(u_out%psi,1))) - ALLOCATE(c1(SIZE(u_out%psi,1))) - b1 = (t(3)**2*(u1%psi - u2%psi) + t(2)**2*(-u1%psi + u3%psi))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%psi + t(3)*u2%psi - t(2)*u3%psi ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%psi = u1%psi + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) + b = (t(3)**2*(u1%psi(i1) - u2%psi(i1)) + t(2)**2*(-u1%psi(i1) + u3%psi(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%psi(i1) + t(3)*u2%psi(i1) - t(2)*u3%psi(i1) ) * scaleFactor + u_out%psi(i1) = u1%psi(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%omega = u1%omega + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor + c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor + u_out%omega = u1%omega + b + c * t_out IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - ALLOCATE(b2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - ALLOCATE(c2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - b2 = (t(3)**2*(u1%Vx - u2%Vx) + t(2)**2*(-u1%Vx + u3%Vx))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vx + t(3)*u2%Vx - t(2)*u3%Vx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vx = u1%Vx + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) + DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) + b = (t(3)**2*(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + t(2)**2*(-u1%Vx(i1,i2) + u3%Vx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vx(i1,i2) + t(3)*u2%Vx(i1,i2) - t(2)*u3%Vx(i1,i2) ) * scaleFactor + u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - ALLOCATE(b2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - ALLOCATE(c2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - b2 = (t(3)**2*(u1%Vy - u2%Vy) + t(2)**2*(-u1%Vy + u3%Vy))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vy + t(3)*u2%Vy - t(2)*u3%Vy ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vy = u1%Vy + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) + DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) + b = (t(3)**2*(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + t(2)**2*(-u1%Vy(i1,i2) + u3%Vy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vy(i1,i2) + t(3)*u2%Vy(i1,i2) - t(2)*u3%Vy(i1,i2) ) * scaleFactor + u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - ALLOCATE(b2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - ALLOCATE(c2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - b2 = (t(3)**2*(u1%rLocal - u2%rLocal) + t(2)**2*(-u1%rLocal + u3%rLocal))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%rLocal + t(3)*u2%rLocal - t(2)*u3%rLocal ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%rLocal = u1%rLocal + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) + DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) + b = (t(3)**2*(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + t(2)**2*(-u1%rLocal(i1,i2) + u3%rLocal(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%rLocal(i1,i2) + t(3)*u2%rLocal(i1,i2) - t(2)*u3%rLocal(i1,i2) ) * scaleFactor + u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Un_disk = u1%Un_disk + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor + u_out%Un_disk = u1%Un_disk + b + c * t_out IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp2 @@ -5365,14 +5324,14 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5385,109 +5344,111 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - ALLOCATE(b2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - ALLOCATE(c2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - b2 = -(y1%Vrel - y2%Vrel)/t(2) - y_out%Vrel = y1%Vrel + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) + DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) + b = -(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - ALLOCATE(b2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - ALLOCATE(c2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - b2 = -(y1%phi - y2%phi)/t(2) - y_out%phi = y1%phi + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) + DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) + b = -(y1%phi(i1,i2) - y2%phi(i1,i2)) + y_out%phi(i1,i2) = y1%phi(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - ALLOCATE(b2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - ALLOCATE(c2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - b2 = -(y1%axInduction - y2%axInduction)/t(2) - y_out%axInduction = y1%axInduction + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) + DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) + b = -(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - ALLOCATE(b2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - ALLOCATE(c2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - b2 = -(y1%tanInduction - y2%tanInduction)/t(2) - y_out%tanInduction = y1%tanInduction + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) + DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) + b = -(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - ALLOCATE(b2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - ALLOCATE(c2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - b2 = -(y1%Re - y2%Re)/t(2) - y_out%Re = y1%Re + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) + DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) + b = -(y1%Re(i1,i2) - y2%Re(i1,i2)) + y_out%Re(i1,i2) = y1%Re(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - ALLOCATE(b2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - ALLOCATE(c2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - b2 = -(y1%AOA - y2%AOA)/t(2) - y_out%AOA = y1%AOA + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) + DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) + b = -(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - ALLOCATE(b2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - ALLOCATE(c2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - b2 = -(y1%Cx - y2%Cx)/t(2) - y_out%Cx = y1%Cx + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) + DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) + b = -(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - ALLOCATE(b2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - ALLOCATE(c2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - b2 = -(y1%Cy - y2%Cy)/t(2) - y_out%Cy = y1%Cy + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) + DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) + b = -(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - ALLOCATE(b2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - ALLOCATE(c2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - b2 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) + DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) + b = -(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - ALLOCATE(b2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - ALLOCATE(c2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - b2 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) + DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) + b = -(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - ALLOCATE(b2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - ALLOCATE(c2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - b2 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) + DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) + b = -(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - ALLOCATE(b2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - ALLOCATE(c2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - b2 = -(y1%chi - y2%chi)/t(2) - y_out%chi = y1%chi + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) + DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) + b = -(y1%chi(i1,i2) - y2%chi(i1,i2)) + y_out%chi(i1,i2) = y1%chi(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - ALLOCATE(b2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - ALLOCATE(c2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - b2 = -(y1%Cpmin - y2%Cpmin)/t(2) - y_out%Cpmin = y1%Cpmin + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) + DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) + b = -(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Output_ExtrapInterp1 @@ -5518,15 +5479,16 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5545,122 +5507,124 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - ALLOCATE(b2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - ALLOCATE(c2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - b2 = (t(3)**2*(y1%Vrel - y2%Vrel) + t(2)**2*(-y1%Vrel + y3%Vrel))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Vrel + t(3)*y2%Vrel - t(2)*y3%Vrel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Vrel = y1%Vrel + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) + DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) + b = (t(3)**2*(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + t(2)**2*(-y1%Vrel(i1,i2) + y3%Vrel(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Vrel(i1,i2) + t(3)*y2%Vrel(i1,i2) - t(2)*y3%Vrel(i1,i2) ) * scaleFactor + y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - ALLOCATE(b2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - ALLOCATE(c2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - b2 = (t(3)**2*(y1%phi - y2%phi) + t(2)**2*(-y1%phi + y3%phi))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%phi + t(3)*y2%phi - t(2)*y3%phi ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%phi = y1%phi + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) + DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) + b = (t(3)**2*(y1%phi(i1,i2) - y2%phi(i1,i2)) + t(2)**2*(-y1%phi(i1,i2) + y3%phi(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%phi(i1,i2) + t(3)*y2%phi(i1,i2) - t(2)*y3%phi(i1,i2) ) * scaleFactor + y_out%phi(i1,i2) = y1%phi(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - ALLOCATE(b2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - ALLOCATE(c2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - b2 = (t(3)**2*(y1%axInduction - y2%axInduction) + t(2)**2*(-y1%axInduction + y3%axInduction))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%axInduction + t(3)*y2%axInduction - t(2)*y3%axInduction ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%axInduction = y1%axInduction + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) + DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) + b = (t(3)**2*(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + t(2)**2*(-y1%axInduction(i1,i2) + y3%axInduction(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%axInduction(i1,i2) + t(3)*y2%axInduction(i1,i2) - t(2)*y3%axInduction(i1,i2) ) * scaleFactor + y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - ALLOCATE(b2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - ALLOCATE(c2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - b2 = (t(3)**2*(y1%tanInduction - y2%tanInduction) + t(2)**2*(-y1%tanInduction + y3%tanInduction))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%tanInduction + t(3)*y2%tanInduction - t(2)*y3%tanInduction ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%tanInduction = y1%tanInduction + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) + DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) + b = (t(3)**2*(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + t(2)**2*(-y1%tanInduction(i1,i2) + y3%tanInduction(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%tanInduction(i1,i2) + t(3)*y2%tanInduction(i1,i2) - t(2)*y3%tanInduction(i1,i2) ) * scaleFactor + y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - ALLOCATE(b2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - ALLOCATE(c2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - b2 = (t(3)**2*(y1%Re - y2%Re) + t(2)**2*(-y1%Re + y3%Re))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Re + t(3)*y2%Re - t(2)*y3%Re ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Re = y1%Re + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) + DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) + b = (t(3)**2*(y1%Re(i1,i2) - y2%Re(i1,i2)) + t(2)**2*(-y1%Re(i1,i2) + y3%Re(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Re(i1,i2) + t(3)*y2%Re(i1,i2) - t(2)*y3%Re(i1,i2) ) * scaleFactor + y_out%Re(i1,i2) = y1%Re(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - ALLOCATE(b2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - ALLOCATE(c2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - b2 = (t(3)**2*(y1%AOA - y2%AOA) + t(2)**2*(-y1%AOA + y3%AOA))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%AOA + t(3)*y2%AOA - t(2)*y3%AOA ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%AOA = y1%AOA + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) + DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) + b = (t(3)**2*(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + t(2)**2*(-y1%AOA(i1,i2) + y3%AOA(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%AOA(i1,i2) + t(3)*y2%AOA(i1,i2) - t(2)*y3%AOA(i1,i2) ) * scaleFactor + y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - ALLOCATE(b2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - ALLOCATE(c2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - b2 = (t(3)**2*(y1%Cx - y2%Cx) + t(2)**2*(-y1%Cx + y3%Cx))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cx + t(3)*y2%Cx - t(2)*y3%Cx ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cx = y1%Cx + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) + DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) + b = (t(3)**2*(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + t(2)**2*(-y1%Cx(i1,i2) + y3%Cx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cx(i1,i2) + t(3)*y2%Cx(i1,i2) - t(2)*y3%Cx(i1,i2) ) * scaleFactor + y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - ALLOCATE(b2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - ALLOCATE(c2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - b2 = (t(3)**2*(y1%Cy - y2%Cy) + t(2)**2*(-y1%Cy + y3%Cy))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cy + t(3)*y2%Cy - t(2)*y3%Cy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cy = y1%Cy + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) + DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) + b = (t(3)**2*(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + t(2)**2*(-y1%Cy(i1,i2) + y3%Cy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cy(i1,i2) + t(3)*y2%Cy(i1,i2) - t(2)*y3%Cy(i1,i2) ) * scaleFactor + y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - ALLOCATE(b2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - ALLOCATE(c2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - b2 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) + DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) + b = (t(3)**2*(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + t(2)**2*(-y1%Cm(i1,i2) + y3%Cm(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm(i1,i2) + t(3)*y2%Cm(i1,i2) - t(2)*y3%Cm(i1,i2) ) * scaleFactor + y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - ALLOCATE(b2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - ALLOCATE(c2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - b2 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) + DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) + b = (t(3)**2*(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + t(2)**2*(-y1%Cl(i1,i2) + y3%Cl(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl(i1,i2) + t(3)*y2%Cl(i1,i2) - t(2)*y3%Cl(i1,i2) ) * scaleFactor + y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - ALLOCATE(b2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - ALLOCATE(c2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - b2 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) + DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) + b = (t(3)**2*(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + t(2)**2*(-y1%Cd(i1,i2) + y3%Cd(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd(i1,i2) + t(3)*y2%Cd(i1,i2) - t(2)*y3%Cd(i1,i2) ) * scaleFactor + y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - ALLOCATE(b2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - ALLOCATE(c2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - b2 = (t(3)**2*(y1%chi - y2%chi) + t(2)**2*(-y1%chi + y3%chi))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%chi + t(3)*y2%chi - t(2)*y3%chi ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%chi = y1%chi + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) + DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) + b = (t(3)**2*(y1%chi(i1,i2) - y2%chi(i1,i2)) + t(2)**2*(-y1%chi(i1,i2) + y3%chi(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%chi(i1,i2) + t(3)*y2%chi(i1,i2) - t(2)*y3%chi(i1,i2) ) * scaleFactor + y_out%chi(i1,i2) = y1%chi(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - ALLOCATE(b2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - ALLOCATE(c2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - b2 = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cpmin = y1%Cpmin + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) + DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) + b = (t(3)**2*(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + t(2)**2*(-y1%Cpmin(i1,i2) + y3%Cpmin(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cpmin(i1,i2) + t(3)*y2%Cpmin(i1,i2) - t(2)*y3%Cpmin(i1,i2) ) * scaleFactor + y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 981f5f5f3e..a9f63471bd 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -38,7 +38,7 @@ module DBEMT subroutine DBEMT_ValidateInitInp(interval, InitInp, errStat, errMsg) - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds type(DBEMT_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None @@ -98,7 +98,7 @@ subroutine DBEMT_Init( InitInp, u, p, x, OtherState, m, Interval, InitOut, ErrSt type(DBEMT_ContinuousStateType), intent( out) :: x !< Initial continuous states type(DBEMT_OtherStateType), intent( out) :: OtherState !< Initial other/logical states type(DBEMT_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds: the rate that !! (1) DBEMT_UpdateStates() is called in loose coupling & !! (2) DBEMT_UpdateDiscState() is called in tight coupling. !! Input is the suggested time from the glue code; @@ -234,9 +234,7 @@ subroutine DBEMT_UpdateStates( i, j, t, u, p, x, OtherState, m, errStat, errMsg ! local variables real(ReKi) :: spanRatio ! local version of r / R - real(ReKi) :: temp, tau2 , A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 - real(ReKi) :: Un_disk - real(ReKi) :: AxInd_disk + real(ReKi) :: tau2 , A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 integer(IntKi) :: indx character(*), parameter :: RoutineName = 'DBEMT_UpdateStates' diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 278226f56c..2f3fa7499c 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -266,24 +266,24 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c6 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c7 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c8 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c9 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_0ye + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c6 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c7 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c8 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c9 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -297,11 +297,15 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%spanRatio)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%spanRatio))-1 ) = PACK(InData%spanRatio,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%spanRatio) + DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) + DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) + ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -315,8 +319,12 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE DBEMT_PackInitInput @@ -333,12 +341,6 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -355,24 +357,24 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c6 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c7 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c8 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c9 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k_0ye = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c6 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c7 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c8 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c9 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -389,18 +391,15 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%spanRatio)>0) OutData%spanRatio = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%spanRatio))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%spanRatio) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) + DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) + OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -417,15 +416,12 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackInitInput @@ -583,12 +579,6 @@ SUBROUTINE DBEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInitOutput' @@ -800,8 +790,14 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind))-1 ) = PACK(InData%vind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind) + DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) + DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) + DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) + ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vind_1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -819,8 +815,14 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind_1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind_1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind_1))-1 ) = PACK(InData%vind_1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind_1) + DO i3 = LBOUND(InData%vind_1,3), UBOUND(InData%vind_1,3) + DO i2 = LBOUND(InData%vind_1,2), UBOUND(InData%vind_1,2) + DO i1 = LBOUND(InData%vind_1,1), UBOUND(InData%vind_1,1) + ReKiBuf(Re_Xferred) = InData%vind_1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_PackContState @@ -837,12 +839,6 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -878,15 +874,14 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind)>0) OutData%vind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) + DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) + DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) + OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vind_1 not allocated Int_Xferred = Int_Xferred + 1 @@ -907,15 +902,14 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind_1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind_1)>0) OutData%vind_1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind_1))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind_1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind_1,3), UBOUND(OutData%vind_1,3) + DO i2 = LBOUND(OutData%vind_1,2), UBOUND(OutData%vind_1,2) + DO i1 = LBOUND(OutData%vind_1,1), UBOUND(OutData%vind_1,1) + OutData%vind_1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackContState @@ -1010,8 +1004,8 @@ SUBROUTINE DBEMT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscreteState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscreteState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackDiscState SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1027,12 +1021,6 @@ SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackDiscState' @@ -1046,8 +1034,8 @@ SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscreteState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscreteState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackDiscState SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1141,8 +1129,8 @@ SUBROUTINE DBEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackConstrState SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1158,12 +1146,6 @@ SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackConstrState' @@ -1177,8 +1159,8 @@ SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackConstrState SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1309,11 +1291,15 @@ SUBROUTINE DBEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%areStatesInitialized)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%areStatesInitialized)-1 ) = TRANSFER(PACK( InData%areStatesInitialized ,.TRUE.), IntKiBuf(1), SIZE(InData%areStatesInitialized)) - Int_Xferred = Int_Xferred + SIZE(InData%areStatesInitialized) + DO i2 = LBOUND(InData%areStatesInitialized,2), UBOUND(InData%areStatesInitialized,2) + DO i1 = LBOUND(InData%areStatesInitialized,1), UBOUND(InData%areStatesInitialized,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%areStatesInitialized(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackOtherState SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1329,12 +1315,6 @@ SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1366,18 +1346,15 @@ SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%areStatesInitialized)>0) OutData%areStatesInitialized = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%areStatesInitialized))-1 ), OutData%areStatesInitialized), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%areStatesInitialized) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%areStatesInitialized,2), UBOUND(OutData%areStatesInitialized,2) + DO i1 = LBOUND(OutData%areStatesInitialized,1), UBOUND(OutData%areStatesInitialized,1) + OutData%areStatesInitialized(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%areStatesInitialized(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%tau1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%tau1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackOtherState SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1471,8 +1448,8 @@ SUBROUTINE DBEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_tau1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_tau1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_PackMisc SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1488,12 +1465,6 @@ SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackMisc' @@ -1507,8 +1478,8 @@ SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_tau1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_tau1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_tau1) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_UnPackMisc SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,16 +1607,16 @@ SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_0ye + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1659,11 +1630,15 @@ SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%spanRatio)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%spanRatio))-1 ) = PACK(InData%spanRatio,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%spanRatio) + DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) + DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) + ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_PackParam SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1679,12 +1654,6 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1700,16 +1669,16 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k_0ye = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1726,18 +1695,15 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%spanRatio)>0) OutData%spanRatio = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%spanRatio))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%spanRatio) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) + DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) + OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_UnPackParam SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1840,16 +1806,18 @@ SUBROUTINE DBEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxInd_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind_s))-1 ) = PACK(InData%vind_s,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind_s) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%spanRatio - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxInd_disk + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Un_disk + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R_disk + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%vind_s,1), UBOUND(InData%vind_s,1) + ReKiBuf(Re_Xferred) = InData%vind_s(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%spanRatio + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackInput SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1865,12 +1833,6 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1885,25 +1847,20 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AxInd_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Un_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AxInd_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Un_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%vind_s,1) i1_u = UBOUND(OutData%vind_s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%vind_s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind_s))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind_s) - DEALLOCATE(mask1) - OutData%spanRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%vind_s,1), UBOUND(OutData%vind_s,1) + OutData%vind_s(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%spanRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackInput SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2038,8 +1995,14 @@ SUBROUTINE DBEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind))-1 ) = PACK(InData%vind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind) + DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) + DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) + DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) + ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_PackOutput @@ -2056,12 +2019,6 @@ SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -2097,15 +2054,14 @@ SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind)>0) OutData%vind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) + DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) + DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) + OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackOutput @@ -2184,12 +2140,12 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2202,20 +2158,20 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%AxInd_disk - u2%AxInd_disk)/t(2) - u_out%AxInd_disk = u1%AxInd_disk + b0 * t_out - b0 = -(u1%Un_disk - u2%Un_disk)/t(2) - u_out%Un_disk = u1%Un_disk + b0 * t_out - b0 = -(u1%R_disk - u2%R_disk)/t(2) - u_out%R_disk = u1%R_disk + b0 * t_out - ALLOCATE(b1(SIZE(u_out%vind_s,1))) - ALLOCATE(c1(SIZE(u_out%vind_s,1))) - b1 = -(u1%vind_s - u2%vind_s)/t(2) - u_out%vind_s = u1%vind_s + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%spanRatio - u2%spanRatio)/t(2) - u_out%spanRatio = u1%spanRatio + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%AxInd_disk - u2%AxInd_disk) + u_out%AxInd_disk = u1%AxInd_disk + b * ScaleFactor + b = -(u1%Un_disk - u2%Un_disk) + u_out%Un_disk = u1%Un_disk + b * ScaleFactor + b = -(u1%R_disk - u2%R_disk) + u_out%R_disk = u1%R_disk + b * ScaleFactor + DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) + b = -(u1%vind_s(i1) - u2%vind_s(i1)) + u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor + END DO + b = -(u1%spanRatio - u2%spanRatio) + u_out%spanRatio = u1%spanRatio + b * ScaleFactor END SUBROUTINE DBEMT_Input_ExtrapInterp1 @@ -2245,13 +2201,14 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2270,25 +2227,25 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AxInd_disk = u1%AxInd_disk + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Un_disk = u1%Un_disk + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%R_disk = u1%R_disk + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%vind_s,1))) - ALLOCATE(c1(SIZE(u_out%vind_s,1))) - b1 = (t(3)**2*(u1%vind_s - u2%vind_s) + t(2)**2*(-u1%vind_s + u3%vind_s))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%vind_s + t(3)*u2%vind_s - t(2)*u3%vind_s ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%vind_s = u1%vind_s + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%spanRatio = u1%spanRatio + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) * scaleFactor + u_out%AxInd_disk = u1%AxInd_disk + b + c * t_out + b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor + u_out%Un_disk = u1%Un_disk + b + c * t_out + b = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) * scaleFactor + u_out%R_disk = u1%R_disk + b + c * t_out + DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) + b = (t(3)**2*(u1%vind_s(i1) - u2%vind_s(i1)) + t(2)**2*(-u1%vind_s(i1) + u3%vind_s(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%vind_s(i1) + t(3)*u2%vind_s(i1) - t(2)*u3%vind_s(i1) ) * scaleFactor + u_out%vind_s(i1) = u1%vind_s(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))* scaleFactor + c = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) * scaleFactor + u_out%spanRatio = u1%spanRatio + b + c * t_out END SUBROUTINE DBEMT_Input_ExtrapInterp2 @@ -2366,16 +2323,16 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2388,15 +2345,17 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - ALLOCATE(b3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - ALLOCATE(c3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - b3 = -(y1%vind - y2%vind)/t(2) - y_out%vind = y1%vind + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) + DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) + DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) + b = -(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated END SUBROUTINE DBEMT_Output_ExtrapInterp1 @@ -2427,17 +2386,18 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2456,16 +2416,18 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - ALLOCATE(b3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - ALLOCATE(c3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - b3 = (t(3)**2*(y1%vind - y2%vind) + t(2)**2*(-y1%vind + y3%vind))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*y1%vind + t(3)*y2%vind - t(2)*y3%vind ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%vind = y1%vind + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) + DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) + DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) + b = (t(3)**2*(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + t(2)**2*(-y1%vind(i1,i2,i3) + y3%vind(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%vind(i1,i2,i3) + t(3)*y2%vind(i1,i2,i3) - t(2)*y3%vind(i1,i2,i3) ) * scaleFactor + y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated END SUBROUTINE DBEMT_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 new file mode 100644 index 0000000000..0782068e39 --- /dev/null +++ b/modules/aerodyn/src/FVW.f90 @@ -0,0 +1,1165 @@ +!> +!! +!! Abbreviations: +!! - FVW: Free Vortex Wake +!! - LL : Lifting Line +!! - CP : Control point +!! - NW : Near Wake +!! - FW : Far Wake +!! +module FVW + use NWTC_Library + use FVW_Types + use FVW_Subs + use FVW_IO + use FVW_Wings + use FVW_BiotSavart + use FVW_Tests + use AirFoilInfo + + IMPLICIT NONE + + PRIVATE + + type(ProgDesc), parameter :: FVW_Ver = ProgDesc( 'FVW', '', '' ) + + public :: FVW_Init ! Initialization routine + public :: FVW_End + + public :: FVW_CalcOutput + public :: FVW_UpdateStates + + ! parameter for deciding if enough time has elapsed (Wake calculation, and vtk output) + real(DbKi), parameter :: OneMinusEpsilon = 1 - 10000*EPSILON(1.0_DbKi) + +contains + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The parameters are set here and not changed during the simulation. +!! The initial states and initial guess for the input are defined. +subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) + use OMP_LIB ! wrap with #ifdef _OPENMP if this causes an issue + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data, temporary, for UA.. + type(FVW_InitInputType), intent(inout) :: InitInp !< Input data for initialization routine (inout so we can use MOVE_ALLOC) + type(FVW_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(FVW_ParameterType), intent( out) :: p !< Parameters + type(FVW_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(FVW_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(FVW_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(FVW_OtherStateType), intent( out) :: OtherState !< Initial other states + type(FVW_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + type(FVW_MiscVarType), intent( out) :: m !< Initial misc/optimization variables + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + !! (1) FVW_UpdateStates() is called in loose coupling & + !! (2) FVW_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. + type(FVW_InitOutputType), intent( out) :: InitOut !< Output for initialization routine + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message + integer(IntKi) :: UnEcho ! Unit number for the echo file + character(*), parameter :: RoutineName = 'FVW_Init' + type(FVW_InputFile) :: InputFileData !< Data stored in the module's input file + character(len=1054) :: DirName + + ! Initialize variables for this routine + ErrStat = ErrID_None + ErrMsg = "" + UnEcho = -1 + + ! Initialize the NWTC Subroutine Library + call NWTC_Init( EchoLibVer=.FALSE. ) + + ! Display the module information + call DispNVD( FVW_Ver ) + ! Display convenient info to screen, until this is one day displayed by OpenFAST + call getcwd(DirName) + call WrScr(' - Directory: '//trim(DirName)) + call WrScr(' - RootName: '//trim(InitInp%RootName)) +#ifdef _OPENMP + call WrScr(' - Compiled with OpenMP') + !$OMP PARALLEL default(shared) + if (omp_get_thread_num()==0) then + call WrScr(' Number of threads: '//trim(Num2LStr(omp_get_num_threads()))//'/'//trim(Num2LStr(omp_get_max_threads()))) + endif + !$OMP END PARALLEL +#else + call WrScr(' - No OpenMP support') +#endif + if (DEV_VERSION) then + CALL FVW_RunTests(ErrStat2, ErrMsg2); if (Failed()) return + endif + + ! Set Parameters and *Misc* from inputs + CALL FVW_SetParametersFromInputs(InitInp, p, ErrStat2, ErrMsg2); if(Failed()) return + + ! Read and parse the input file here to get other parameters and info + CALL FVW_ReadInputFile(InitInp%FVWFileName, p, InputFileData, ErrStat2, ErrMsg2); if(Failed()) return + + ! Trigger required before allocations + p%nNWMax = max(InputFileData%nNWPanels,0)+1 ! +1 since LL panel included in NW + p%nFWMax = max(InputFileData%nFWPanels,0) + p%nFWFree = max(InputFileData%nFWPanelsFree,0) + p%DTfvw = InputFileData%DTfvw + p%DTvtk = InputFileData%DTvtk + + ! Initialize Misc Vars (may depend on input file) + CALL FVW_InitMiscVars( p, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! Move the InitInp%WingsMesh to u + CALL MOVE_ALLOC( InitInp%WingsMesh, u%WingsMesh ) ! Move from InitInp to u + +!NOTE: We do not have the windspeed until after the FVW initialization (IfW is not initialized until after AD15) + ! Wind Speed hack, TODO temporary NOTE: it is still needed? + m%Vwnd_LL(:,:,:) = 0 + m%Vwnd_NW(:,:,:,:) = 0 + m%Vwnd_FW(:,:,:,:) = 0 + + ! This mesh is passed in as a cousin of the BladeMotion mesh. + CALL Wings_Panelling_Init(u%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! Set parameters from InputFileData (need Misc allocated) + CALL FVW_SetParametersFromInputFile(InputFileData, p, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! Initialize Misc Vars (after input file params) + CALL FVW_InitMiscVarsPostParam( p, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! Initialize States Vars + CALL FVW_InitStates( x, p, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! Initialize Constraints Vars + CALL FVW_InitConstraint( z, p, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! Panelling wings based on initial input mesh provided + ! This mesh is now a cousin of the BladeMotion mesh from AD. + CALL Wings_Panelling (u%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return + CALL FVW_InitRegularization(p, m, ErrStat2, ErrMsg2); if(Failed()) return + CALL FVW_ToString(p, m) ! Print to screen + + ! Mapping NW and FW (purely for esthetics, and maybe wind) ! TODO, just points + call Map_LL_NW(p, m, z, x, 1.0_ReKi, ErrStat2, ErrMsg2); if(Failed()) return + call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return + + ! Initialize output + CALL FVW_Init_Y( p, u, y, ErrStat2, ErrMsg2); if(Failed()) return + + ! Returned guessed locations where wind will be required + CALL SetRequestedWindPoints(m%r_wind, x, p, m ) + ! Return anything in FVW_InitOutput that should be passed back to the calling code here + + + ! --- UA + ! NOTE: quick and dirty since this should belong to AD + interval = InitInp%DTAero ! important, UA, needs proper interval + call UA_Init_Wrapper(AFInfo, InitInp, interval, p, x, xd, OtherState, m, ErrStat2, ErrMsg2); if (Failed()) return + + ! Framework types unused + Interval = InitInp%DTAero + OtherState%NULL = 0 + xd%NULL = 0 + InitOut%NULL = 0 +CONTAINS + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_Init') + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed + +end subroutine FVW_Init + +! ============================================================================== +subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: 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_InitMiscVars' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + m%FirstCall = .True. + m%nNW = iNWStart-1 ! Number of active nearwake panels + m%nFW = 0 ! Number of active farwake panels + m%iStep = 0 ! Current step number + m%VTKStep = -1 ! Counter of VTK outputs + m%VTKlastTime = -HUGE(1.0_DbKi) + m%tSpent = 0 + + call AllocAry( m%LE , 3 , p%nSpan+1 , p%nWings, 'Leading Edge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%LE = -999999_ReKi; + call AllocAry( m%TE , 3 , p%nSpan+1 , p%nWings, 'TrailingEdge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%TE = -999999_ReKi; + call AllocAry( m%s_LL , p%nSpan+1 , p%nWings, 'Spanwise coord LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%s_LL= -999999_ReKi; + call AllocAry( m%chord_LL , p%nSpan+1 , p%nWings, 'Chord on LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%chord_LL= -999999_ReKi; + call AllocAry( m%PitchAndTwist , p%nSpan+1 , p%nWings, 'Pitch and twist ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%PitchAndTwist= -999999_ReKi; + call AllocAry( m%alpha_LL, p%nSpan , p%nWings, 'Wind on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%alpha_LL= -999999_ReKi; + call AllocAry( m%Vreln_LL, p%nSpan , p%nWings, 'Wind on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vreln_LL = -999999_ReKi; + ! Variables at control points/elements + call AllocAry( m%Gamma_LL, p%nSpan , p%nWings, 'Lifting line Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Gamma_LL = -999999_ReKi; + call AllocAry( m%chord_CP_LL , p%nSpan , p%nWings, 'Chord on CP LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%chord_CP_LL= -999999_ReKi; + call AllocAry( m%s_CP_LL , p%nSpan , p%nWings, 'Spanwise coord CPll', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%s_CP_LL= -999999_ReKi; + call AllocAry( m%CP_LL , 3 , p%nSpan , p%nWings, 'Control points LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%CP_LL= -999999_ReKi; + call AllocAry( m%Tang , 3 , p%nSpan , p%nWings, 'Tangential vector ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Tang= -999999_ReKi; + call AllocAry( m%Norm , 3 , p%nSpan , p%nWings, 'Normal vector ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Norm= -999999_ReKi; + call AllocAry( m%Orth , 3 , p%nSpan , p%nWings, 'Orthogonal vector ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Orth= -999999_ReKi; + call AllocAry( m%dl , 3 , p%nSpan , p%nWings, 'Orthogonal vector ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%dl= -999999_ReKi; + call AllocAry( m%Area , p%nSpan , p%nWings, 'LL Panel area ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Area = -999999_ReKi; + call AllocAry( m%diag_LL , p%nSpan , p%nWings, 'LL Panel diagonals ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%diag_LL = -999999_ReKi; + call AllocAry( m%Vind_LL , 3 , p%nSpan , p%nWings, 'Vind on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vind_LL= -999999_ReKi; + call AllocAry( m%Vtot_LL , 3 , p%nSpan , p%nWings, 'Vtot on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vtot_LL= -999999_ReKi; + call AllocAry( m%Vstr_LL , 3 , p%nSpan , p%nWings, 'Vstr on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vstr_LL= -999999_ReKi; + call AllocAry( m%Vwnd_LL , 3 , p%nSpan , p%nWings, 'Wind on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vwnd_LL= -999999_ReKi; + ! Variables at panels points + call AllocAry( m%r_LL , 3 , p%nSpan+1 , 2 , p%nWings, 'Lifting Line Panels', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%r_LL= -999999_ReKi; + call AllocAry( m%Vwnd_NW , 3 , p%nSpan+1 ,p%nNWMax+1, p%nWings, 'Wind on NW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vwnd_NW= -999_ReKi; + call AllocAry( m%Vwnd_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Wind on FW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vwnd_FW= -999_ReKi; + call AllocAry( m%Vind_NW , 3 , p%nSpan+1 ,p%nNWMax+1, p%nWings, 'Vind on NW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vind_NW= -999_ReKi; + call AllocAry( m%Vind_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Vind on FW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vind_FW= -999_ReKi; + call AllocAry( m%dxdt_NW , 3 , p%nSpan+1 , p%nNWMax+1, p%nWings, 'NW dxdt' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%dxdt_NW = -999999_ReKi; + call AllocAry( m%dxdt_FW , 3 , FWnSpan+1 , p%nFWMax+1, p%nWings, 'FW dxdt' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%dxdt_FW = -999999_ReKi; + ! Variables for optimizing outputs at blade nodes + call AllocAry( m%BN_UrelWind_s, 3, p%nSpan+1 , p%nWings, 'Relative wind in section coordinates', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_UrelWind_s= -999999_ReKi; + call AllocAry( m%BN_AxInd , p%nSpan+1 , p%nWings, 'Axial induction', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_AxInd = -999999_ReKi; + call AllocAry( m%BN_TanInd , p%nSpan+1 , p%nWings, 'Tangential induction', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_TanInd = -999999_ReKi; + call AllocAry( m%BN_Vrel , p%nSpan+1 , p%nWings, 'Relative velocity', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Vrel = -999999_ReKi; + call AllocAry( m%BN_alpha , p%nSpan+1 , p%nWings, 'Angle of attack', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_alpha = -999999_ReKi; + call AllocAry( m%BN_phi , p%nSpan+1 , p%nWings, 'angle between the plane local wind dir', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_phi = -999999_ReKi; + call AllocAry( m%BN_Re , p%nSpan+1 , p%nWings, 'Reynolds number', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Re = -999999_ReKi; + call AllocAry( m%BN_Cl_Static , p%nSpan+1 , p%nWings, 'Coefficient lift - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cl_Static = -999999_ReKi; + call AllocAry( m%BN_Cd_Static , p%nSpan+1 , p%nWings, 'Coefficient drag - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cd_Static = -999999_ReKi; + call AllocAry( m%BN_Cm_Static , p%nSpan+1 , p%nWings, 'Coefficient moment - no UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cm_Static = -999999_ReKi; + call AllocAry( m%BN_Cl , p%nSpan+1 , p%nWings, 'Coefficient lift - with UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cl = -999999_ReKi; + call AllocAry( m%BN_Cd , p%nSpan+1 , p%nWings, 'Coefficient drag - with UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cd = -999999_ReKi; + call AllocAry( m%BN_Cm , p%nSpan+1 , p%nWings, 'Coefficient moment - with UA', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cm = -999999_ReKi; + call AllocAry( m%BN_Cx , p%nSpan+1 , p%nWings, 'Coefficient normal (to plane)', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cx = -999999_ReKi; + call AllocAry( m%BN_Cy , p%nSpan+1 , p%nWings, 'Coefficient tangential (to plane)', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cy = -999999_ReKi; + + + ! Wind request points + nMax = 0 + nMax = nMax + p%nSpan * p%nWings ! Lifting line Control Points + nMax = nMax + (p%nSpan+1) * (p%nNWMax+1) * p%nWings ! Nearwake points + nMax = nMax + (FWnSpan+1) * (p%nFWMax+1) * p%nWings ! Far wake points + call AllocAry( m%r_wind, 3, nMax, 'Requested wind points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) + m%r_wind = 0.0_ReKi ! set to zero so InflowWind can shortcut calculations + m%OldWakeTime = -HUGE(1.0_DbKi) + ! Temporary UA + call AllocAry( m%Vwnd_ND, 3, p%nSpan+1, p%nWings, 'Vwnd_ND', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%TE = -999999_ReKi; + +end subroutine FVW_InitMiscVars +! ============================================================================== +subroutine FVW_InitMiscVarsPostParam( p, m, ErrStat, ErrMsg ) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'FVW_InitMiscVarsPostParam' + integer(IntKi) :: nSeg, nSegP, nSegNW !< Total number of segments after packing + integer(IntKi) :: nCPs !< Total number of control points + logical :: bMirror + ErrStat = ErrID_None + ErrMsg = "" + ! --- Counting maximum number of segments and Control Points expected for the whole simulation + call CountSegments(p, p%nNWMax, p%nFWMax, 1, nSeg, nSegP, nSegNW) + nCPs = CountCPs(p, p%nNWMax, p%nFWFree) + + bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground + if (bMirror) then + nSeg = nSeg*2 + nSegP = nSegP*2 + endif + call AllocAry( m%SegConnct, 4, nSeg , 'SegConnct' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegConnct = -999; + call AllocAry( m%SegPoints, 3, nSegP, 'SegPoints' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegPoints = -999999_ReKi; + call AllocAry( m%SegGamma , nSeg, 'SegGamma' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegGamma = -999999_ReKi; + call AllocAry( m%SegEpsilon, nSeg, 'SegEpsilon', ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegEpsilon= -999999_ReKi; + + call AllocAry( m%CPs , 3, nCPs, 'CPs' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%CPs= -999999_ReKi; + call AllocAry( m%Uind , 3, nCPs, 'Uind' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%Uind= -999999_ReKi; + +end subroutine FVW_InitMiscVarsPostParam +! ============================================================================== +subroutine FVW_InitStates( x, p, ErrStat, ErrMsg ) + type(FVW_ContinuousStateType), intent( out) :: x !< States + type(FVW_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 + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'FVW_InitMiscVars' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + call AllocAry( x%Gamma_NW, p%nSpan , p%nNWMax , p%nWings, 'NW Panels Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); + call AllocAry( x%Gamma_FW, FWnSpan , p%nFWMax , p%nWings, 'FW Panels Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); + ! set x%r_NW and x%r_FW to (0,0,0) so that InflowWind can shortcut the calculations + call AllocAry( x%r_NW , 3, p%nSpan+1 , p%nNWMax+1, p%nWings, 'NW Panels Points' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); + call AllocAry( x%r_FW , 3, FWnSpan+1 , p%nFWMax+1, p%nWings, 'FW Panels Points' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); + !if (DEV_VERSION) then + ! x%r_NW = -9999999_ReKi; + ! x%r_FW = -9999999_ReKi; + ! x%Gamma_NW = -999999_ReKi; + ! x%Gamma_FW = -999999_ReKi; + !else + x%r_NW = 0.0_ReKi + x%r_FW = 0.0_ReKi + x%Gamma_NW = 0.0_ReKi ! First call of calcoutput, states might not be set + x%Gamma_FW = 0.0_ReKi ! NOTE, these values might be mapped from z%Gamma_LL at init + !endif + if (ErrStat >= AbortErrLev) return +end subroutine FVW_InitStates +! ============================================================================== +subroutine FVW_InitConstraint( z, p, m, ErrStat, ErrMsg ) + type(FVW_ConstraintStateType), intent( out) :: z !< Constraints + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'FVW_InitMiscVars' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! + call AllocAry( z%Gamma_LL, p%nSpan, p%nWings, 'Lifting line Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitConstraint' ); + !z%Gamma_LL = -999999_ReKi + z%Gamma_LL = 0.0_ReKi + + if (ErrStat >= AbortErrLev) return + if(.false.) print*,m%nNW ! unused var for now +end subroutine FVW_InitConstraint +! ============================================================================== +subroutine FVW_Init_Y( p, u, y, ErrStat, ErrMsg ) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + 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_Y' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! + nMax = 0 + nMax = nMax + p%nSpan * p%nWings ! Lifting line Control Points + nMax = nMax + (p%nSpan+1) * (p%nNWMax+1) * p%nWings ! Nearwake points + nMax = nMax + (FWnSpan+1) * (p%nFWMax+1) * p%nWings ! Far wake points + + call AllocAry( u%V_wind, 3, nMax, 'Wind Velocity at points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) + call AllocAry( y%Vind , 3, p%nSpan+1, p%nWings, 'Induced velocity vector', ErrStat2, ErrMsg2 ); ! TODO potentially nSpan+1 for AD15 + !call AllocAry( y%Cl_KJ , 1, 1, 'Lift coefficient from circulation (Kutta-Joukowski)', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) + if (ErrStat >= AbortErrLev) return + y%Vind = 0.0_ReKi + return +end subroutine FVW_Init_Y + + +! ============================================================================== +!> Setting parameters *and misc* from module inputs +SUBROUTINE FVW_SetParametersFromInputs( InitInp, p, ErrStat, ErrMsg ) + type(FVW_InitInputType), intent(inout) :: InitInp !< Input data for initialization routine (inout so we can use MOVE_ALLOC) + type(FVW_ParameterType), intent(inout) :: p !< Parameters + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + !integer(IntKi) :: ErrStat2 + !character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_SetParametersFromInputs' + ErrStat = ErrID_None + ErrMsg = "" + ! + p%nWings = InitInp%NumBlades + p%nSpan = InitInp%numBladeNodes-1 ! NOTE: temporary limitation, all wings have the same nspan + p%DTaero = InitInp%DTaero ! AeroDyn Time step + p%KinVisc = InitInp%KinVisc ! Kinematic air viscosity + p%RootName = InitInp%RootName ! Rootname for outputs + ! Set indexing to AFI tables -- this is set from the AD15 calling code. + call AllocAry(p%AFindx,size(InitInp%AFindx,1),size(InitInp%AFindx,2),'AFindx',ErrStat,ErrMsg) + p%AFindx = InitInp%AFindx ! Copying in case AD15 still needs these + + ! Set the Chord values + call move_alloc(InitInp%Chord, p%Chord) + +end subroutine FVW_SetParametersFromInputs +! ============================================================================== +!> +SUBROUTINE FVW_SetParametersFromInputFile( InputFileData, p, m, ErrStat, ErrMsg ) + type(FVW_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file + type(FVW_ParameterType), intent(inout) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Misc + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + ErrStat = ErrID_None + ErrMsg = "" + + ! Set parameters from input file + p%IntMethod = InputFileData%IntMethod + p%CirculationMethod = InputFileData%CirculationMethod + p%CircSolvConvCrit = InputFileData%CircSolvConvCrit + p%CircSolvRelaxation = InputFileData%CircSolvRelaxation + p%CircSolvMaxIter = InputFileData%CircSolvMaxIter + p%FreeWakeStart = InputFileData%FreeWakeStart + p%CircSolvPolar = InputFileData%CircSolvPolar + p%FullCirculationStart = InputFileData%FullCirculationStart + p%FWShedVorticity = InputFileData%FWShedVorticity + p%DiffusionMethod = InputFileData%DiffusionMethod + p%RegFunction = InputFileData%RegFunction + p%RegDeterMethod = InputFileData%RegDeterMethod + p%WakeRegMethod = InputFileData%WakeRegMethod + p%WakeRegParam = InputFileData%WakeRegParam + p%WingRegParam = InputFileData%WingRegParam + p%CoreSpreadEddyVisc = InputFileData%CoreSpreadEddyVisc + p%ShearModel = InputFileData%ShearModel + p%TwrShadowOnWake = InputFileData%TwrShadowOnWake + p%VelocityMethod = InputFileData%VelocityMethod + p%TreeBranchFactor = InputFileData%TreeBranchFactor + p%PartPerSegment = InputFileData%PartPerSegment + p%WrVTK = InputFileData%WrVTK + p%VTKBlades = min(InputFileData%VTKBlades,p%nWings) ! Note: allowing it to be negative for temporary hack + p%VTKCoord = InputFileData%VTKCoord + + if (allocated(p%PrescribedCirculation)) deallocate(p%PrescribedCirculation) + if (InputFileData%CirculationMethod==idCircPrescribed) then + call AllocAry( p%PrescribedCirculation, p%nSpan, 'Prescribed Circulation', ErrStat2, ErrMsg2 ); call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_SetParameters' ); p%PrescribedCirculation = -999999_ReKi; + if (.not. allocated(m%s_CP_LL)) then + ErrMsg = 'Spanwise coordinate not allocated.' + ErrStat = ErrID_Fatal + return + endif + call ReadAndInterpGamma(trim(InputFileData%CirculationFile), m%s_CP_LL(1:p%nSpan,1), m%s_LL(p%nSpan+1,1), p%PrescribedCirculation, ErrStat2, ErrMsg2) + call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_SetParameters' ); + endif + +end subroutine FVW_SetParametersFromInputFile + +subroutine FVW_ToString(p,m) + type(FVW_ParameterType), intent(in) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Misc + if (DEV_VERSION) then + print*,'-----------------------------------------------------------------------------------------' + if(.false.) print*,m%nNW ! unused var for now + endif +end subroutine FVW_ToString + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine FVW_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + + type(FVW_InputType), intent(inout) :: u(:) !< System inputs + type(FVW_ParameterType), intent(inout) :: p !< Parameters + type(FVW_ContinuousStateType), intent(inout) :: x !< Continuous states + type(FVW_DiscreteStateType), intent(inout) :: xd !< Discrete states + type(FVW_ConstraintStateType), intent(inout) :: z !< Constraint states + type(FVW_OtherStateType), intent(inout) :: OtherState !< Other states + type(FVW_OutputType), intent(inout) :: y !< System outputs + type(FVW_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: i + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! Place any last minute operations or calculations here: + ! Close files here: + ! Destroy the input data: + do i=1,size(u) + call FVW_DestroyInput( u(i), ErrStat, ErrMsg ) + enddo + + ! Destroy the parameter data: + call FVW_DestroyParam( p, ErrStat, ErrMsg ) + + ! Destroy the state data: + call FVW_DestroyContState( x, ErrStat, ErrMsg ) + call FVW_DestroyDiscState( xd, ErrStat, ErrMsg ) + call FVW_DestroyConstrState( z, ErrStat, ErrMsg ) + call FVW_DestroyOtherState( OtherState, ErrStat, ErrMsg ) + call FVW_DestroyMisc( m, ErrStat, ErrMsg ) + + ! Destroy the output data: + call FVW_DestroyOutput( y, ErrStat, ErrMsg ) + +#ifdef UA_OUTS + CLOSE(69) +#endif +end subroutine FVW_End + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. +!! Continuous, constraint, discrete, and other states are updated for t + Interval +subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m, errStat, errMsg ) +!.................................................................................................................................. + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... + type(FVW_InputType), intent(inout) :: u(:) !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) + real(DbKi), intent(in ) :: utimes(:) !< Times associated with u(:), in seconds + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; Output: at t+DTaero + type(FVW_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; Output: at t+DTaero + type(FVW_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; Output: at t+DTaero + type(FVW_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; Output: at t+DTaero + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data + type(FVW_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! local variables + type(FVW_InputType) :: uInterp ! Interpolated/Extrapolated input + integer(IntKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + type(FVW_ConstraintStateType) :: z_guess ! < + integer(IntKi) :: nP, nFWEff + integer, dimension(8) :: time1, time2, time_diff + real(ReKi) :: ShedScale !< Scaling factor for shed vorticity (for sub-cycling), 1 if no subcycling + logical :: bReevaluation + + ErrStat = ErrID_None + ErrMsg = "" + + + ! --- Handling of time step, and time compared to previous call + m%iStep = n + ! Reevaluation: two repetitive calls starting from the same time, we will roll back the wake emission + bReevaluation=.False. + if (abs(t-m%OldWakeTime)<0.25_ReKi* p%DTaero) then + bReevaluation=.True. + endif + ! Compute Induced wake effects only if time since last compute is > DTfvw + if ( (( t - m%OldWakeTime ) >= p%DTfvw*OneMinusEpsilon) ) then + m%OldWakeTime = t + m%ComputeWakeInduced = .TRUE. ! It's time to update the induced velocities from wake + else + m%ComputeWakeInduced = .FALSE. + endif + if (bReevaluation) then + print*,'[INFO] FVW: Update States: reevaluation at the same starting time' + call RollBackPreviousTimeStep() ! Cancel wake emission done in previous call + m%ComputeWakeInduced = .TRUE. + endif + if (m%ComputeWakeInduced) then + call date_and_time(values=time1) + endif + + + nP = p%nWings * ( (p%nSpan+1)*(m%nNW-1+2) +(FWnSpan+1)*(m%nFW+1) ) + nFWEff = min(m%nFW, p%nFWFree) + ! --- Display some status to screen +!FIXME: this conflicts with the SimStatus WrOver from the FAST_Subs.f90. Leaving out for now. +! Ideally we put this into a log file. +! if (mod(n,10)==0) print'(A,F10.3,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,F7.2,A)','FVW status - t:',t,' n:',n,' nNW:',m%nNW-1,'/',p%nNWMax-1,' nFW:',nFWEff, '+',m%nFW-nFWEff,'=',m%nFW,'/',p%nFWMax,' nP:',nP,' spent:', m%tSpent, 's' + if (DEV_VERSION) print'(A,F10.3,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,F7.2,A,L1)','FVW status - t:',t,' n:',n,' nNW:',m%nNW-1,'/',p%nNWMax-1,' nFW:',nFWEff, '+',m%nFW-nFWEff,'=',m%nFW,'/',p%nFWMax,' nP:',nP,' spent:', m%tSpent, 's Comp:',m%ComputeWakeInduced + + ! --- Evaluation at t + ! Inputs at t + call FVW_CopyInput( u(2), uInterp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + call FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),uInterp,t, ErrStat2, ErrMsg2); if(Failed()) return + call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + CALL DistributeRequestedWind(u(1)%V_wind, p, m) + + ! --- Solve for circulation at t + ! Returns: z%Gamma_LL (at t) + call AllocAry( z_guess%Gamma_LL, p%nSpan, p%nWings, 'Lifting line Circulation', ErrStat, ErrMsg ); + z_guess%Gamma_LL = m%Gamma_LL + call FVW_CalcConstrStateResidual(t, uInterp, p, x, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 1); if(Failed()) return + + call UA_UpdateState_Wrapper(AFInfo, n, uInterp, p, x, xd, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! Map circulation and positions between LL and NW and then NW and FW + ! Changes: x only + ShedScale = 1.0_ReKi + call Map_LL_NW(p, m, z, x, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return + call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return + !call print_x_NW_FW(p, m, x,'Map_') + + ! --- Integration between t and t+DTaero + ! NOTE: when sub-cycling, the previous convection velocity is used + ! If dtfvw = n dtaero, we assume xdot_local dtaero = xdot_stored * dtfvw/n + if (p%IntMethod .eq. idEuler1) then + call FVW_Euler1( t, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + !elseif (p%IntMethod .eq. idRK4) then + ! call FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + !elseif (p%IntMethod .eq. idAB4) then + ! call FVW_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + !elseif (p%IntMethod .eq. idABM4) then + ! call FVW_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + else + call SetErrStat(ErrID_Fatal,'Invalid time integration method:'//Num2LStr(p%IntMethod),ErrStat,ErrMsg,'FVW_UpdateState') + end IF + !call print_x_NW_FW(p, m, x,'Conv') + + if (m%ComputeWakeInduced) then + ! We extend the wake length, i.e. we emit a new panel of vorticity at the TE + ! NOTE: this will be rolled back if UpdateState is called at the same starting time again + call PrepareNextTimeStep() + ! --- t+DTaero + ! Propagation/creation of new layer of panels + call PropagateWake(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return + !call print_x_NW_FW(p, m, x,'Prop_') + endif + + ! Inputs at t+DTaero + call FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes,uInterp,t+p%DTaero, ErrStat2, ErrMsg2); if(Failed()) return + + ! Panelling wings based on input mesh at t+p%DTaero + call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! Updating positions of first NW and FW panels (Circulation also updated but irrelevant) + ! Changes: x only + ShedScale = (t+p%DTaero - m%OldWakeTime)/p%DTfvw + call Map_LL_NW(p, m, z, x, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return + call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return + + !call print_x_NW_FW(p, m, x,'Map2') + + ! --- Solve for circulation at t+p%DTaero + ! Returns: z%Gamma_LL (at t+p%DTaero) + z_guess%Gamma_LL = z%Gamma_LL ! We use as guess the circulation from the previous time step (see above) + call FVW_CalcConstrStateResidual(t+p%DTaero, uInterp, p, x, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 2); if(Failed()) return +! print*,'US: z_Gamma',x%Gamma_NW(1,1,1) +! print*,'US: x_Gamma',z%Gamma_LL(1,1) + + ! Updating circulation of near wake panel (and position but irrelevant) + ! Changes: x only + call Map_LL_NW(p, m, z, x, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return + call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return + !call print_x_NW_FW(p, m, x,'Map3') + + ! --- Fake handling of ground effect + call FakeGroundEffect(p, x, m, ErrStat, ErrMsg) + + ! set the wind points required for t+p%DTaero timestep + CALL SetRequestedWindPoints(m%r_wind, x, p, m) + + if (m%FirstCall) then + m%FirstCall=.False. + endif + if (m%ComputeWakeInduced) then + ! Profiling of expensive time step + call date_and_time(values=time2) + time_diff=time2-time1 + m%tSpent = time_diff(5)*3600+time_diff(6)*60 +time_diff(7)+0.001*time_diff(8) + endif + call FVW_DestroyConstrState(z_guess, ErrStat2, ErrMsg2); if(Failed()) return + +contains + subroutine PrepareNextTimeStep() + ! --- Increase wake length if maximum not reached + if (m%nNW==p%nNWMax) then ! a far wake exist + m%nFW=min(m%nFW+1, p%nFWMax) + endif + m%nNW=min(m%nNW+1, p%nNWMax) + end subroutine PrepareNextTimeStep + + subroutine RollBackPreviousTimeStep() + ! --- Decrease wake length if maximum not reached + if (m%nNW==p%nNWMax) then ! a far wake exist + m%nFW=max(m%nFW-1, 0) + endif + m%nNW=max(m%nNW-1, 0) + end subroutine RollBackPreviousTimeStep + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_UpdateStates') + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed + +end subroutine FVW_UpdateStates + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for computing derivatives of continuous states. +subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(FVW_InputType), intent(in ) :: u !< Inputs at t + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< Continuous states at t + 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(FVW_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(FVW_ContinuousStateType), intent( out) :: dxdt !< Continuous state derivatives at t + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: ErrStat2 ! 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 + real(ReKi), dimension(3) :: VmeanFW, VmeanNW ! Mean velocity of the near wake and far wake + + ErrStat = ErrID_None + ErrMsg = "" + + call AllocAry( dxdt%r_NW , 3 , p%nSpan+1 ,p%nNWMax+1, p%nWings, 'Wind on NW ', ErrStat2, ErrMsg2); dxdt%r_NW= -999999_ReKi; + call AllocAry( dxdt%r_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Wind on FW ', ErrStat2, ErrMsg2); dxdt%r_FW= -999999_ReKi; + if(Failed()) return + + ! Only calculate freewake after start time and if on a timestep when it should be calculated. + if ((t>= p%FreeWakeStart)) then + nFWEff = min(m%nFW, p%nFWFree) + + ! --- Compute Induced velocities on the Near wake and far wake based on the marker postions: + ! (expensive N^2 call) + ! In : x%r_NW, r%r_FW + ! Out: m%Vind_NW, m%Vind_FW + call WakeInducedVelocities(p, x, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! --- Mean induced velocity over the near wake (NW) + VmeanNW(1:3)=0 + if (m%nNW >1) then + do i=1,size(m%Vind_NW,4); do j=2,m%nNW+1; do k=1,size(m%Vind_NW,2); + VmeanNW(1:3) = VmeanNW(1:3) + m%Vind_NW(1:3, k, j, i) + enddo; enddo; enddo; + VmeanNW(1:3) = VmeanNW(1:3) / (size(m%Vind_NW,4)*m%nNW*size(m%Vind_NW,2)) + endif + ! --- Induced velocity over the free far wake (FWEff) + VmeanFW(1:3)=0 + if (nFWEff >0) then + do i=1,size(m%Vind_FW,4); do j=1,nFWEff; do k=1,size(m%Vind_FW,2); + VmeanFW(1:3) = VmeanFW(1:3) + m%Vind_FW(1:3, k, j, i) + enddo; enddo; enddo; + VmeanFW(1:3) = VmeanFW(1:3) / (size(m%Vind_FW,4)*nFWEff*size(m%Vind_FW,2)) + else + VmeanFW=VmeanNW + ! Since we convect the first FW point, we need a reasonable velocity there + ! NOTE: mostly needed for sub-cycling and when no NW + m%Vind_FW(1, 1:FWnSpan+1, 1, 1:p%nWings) = VmeanFW(1) + m%Vind_FW(2, 1:FWnSpan+1, 1, 1:p%nWings) = VmeanFW(2) + m%Vind_FW(3, 1:FWnSpan+1, 1, 1:p%nWings) = VmeanFW(3) + endif + + ! --- Convecting non-free FW with a constant induced velocity (and free stream) + m%Vind_FW(1, 1:FWnSpan+1, p%nFWFree+1:p%nFWMax+1, 1:p%nWings) = VmeanFW(1) ! + m%Vind_FW(2, 1:FWnSpan+1, p%nFWFree+1:p%nFWMax+1, 1:p%nWings) = VmeanFW(2) ! + m%Vind_FW(3, 1:FWnSpan+1, p%nFWFree+1:p%nFWMax+1, 1:p%nWings) = VmeanFW(3) ! + + if (DEV_VERSION) then + call print_mean_4d( m%Vind_NW(:,:, 1:m%nNW+1,:), 'Mean induced vel. NW') + if (nFWEff>0) then + call print_mean_4d( m%Vind_FW(:,:, 1:nFWEff ,:), 'Mean induced vel. FW') + endif + print'(A25,3F12.4)','MeanFW (non free)',VmeanFW + call print_mean_4d( m%Vwnd_NW(:,:, 1:m%nNW+1,:), 'Mean wind vel. NW') + call print_mean_4d( m%Vwnd_FW(:,:, 1:nFWEff+1,:), 'Mean wind vel. FWEff') + call print_mean_4d( m%Vwnd_FW(:,:, (p%nFWFree+1):m%nFW+1,:), 'Mean wind vel. FWNF') + call print_mean_4d( m%Vwnd_FW(:,:, 1:m%nFW+1,:), 'Mean wind vel. FW') + endif + + ! --- Vortex points are convected with the free stream and induced velocity + dxdt%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = m%Vwnd_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + m%Vind_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = m%Vwnd_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + m%Vind_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + else + if(DEV_VERSION) then + call print_mean_4d( m%Vwnd_NW(:,:,1:m%nNW+1,:), 'Mean wind vel. NW') + !call print_mean_4d( m%Vwnd_FW(:,:,1:m%nFW+1,:), 'Mean wind vel. FW') + endif + + ! --- Vortex points are convected with the free stream + dxdt%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = m%Vwnd_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = m%Vwnd_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + ! First NW point does not convect (bound to LL) + dxdt%r_NW(1:3, :, 1:iNWStart-1, :)=0 + ! First FW point always convects (even if bound to NW) + ! This is done for subcycling + !dxdt%r_FW(1:3, :, 1, :)=0 +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_CalcContStateDeriv') + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine FVW_CalcContStateDeriv + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine FVW_Euler1( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(FVW_InputType), intent(in ) :: u !< Input at t + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output + type(FVW_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(FVW_OtherStateType), intent(inout) :: OtherState !< Other states at t on input at t + dt on output + type(FVW_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! local variables + type(FVW_ContinuousStateType) :: dxdt ! time derivatives of continuous states + real(ReKi) :: dt + integer(IntKi) :: ErrStat2 ! temporary error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary error message + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + dt = real(p%DTaero,ReKi) ! NOTE: this is DTaero not DTfvw since we integrate at each sub time step + ! Compute "right hand side" + if (m%ComputeWakeInduced) then + CALL FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2); if (Failed()) return + ! Storage of convection velocity, purely for sub-cycling for now + ! Since Euler1 is linear we use partial increments of dtaero0) then + if (any(m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)<-999)) then + call print_x_NW_FW(p, m, x, 'STP') + print*,'FVW_Euler1: Attempting to convect FW with a wrong velocity' + STOP + endif + endif + endif + + ! Update of positions + x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + ! Update of Gamma + ! TODO, viscous diffusion, stretching + + call FVW_DestroyContState(dxdt, ErrStat2, ErrMsg2); if(Failed()) return +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_Euler1') + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine FVW_Euler1 +!---------------------------------------------------------------------------------------------------------------------------------- + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for solving for the residual of the constraint state functions. +subroutine FVW_CalcConstrStateResidual( t, u, p, x, xd, z_guess, OtherState, m, z_out, AFInfo, ErrStat, ErrMsg, iLabel) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(FVW_InputType), intent(in ) :: u !< Inputs at t + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(FVW_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(FVW_ConstraintStateType), intent(in ) :: z_guess !< Constraint states at t (possibly a guess) + type(FVW_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(FVW_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(FVW_ConstraintStateType), intent( out) :: z_out !< Residual of the constraint state functions using + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data + integer(IntKi), intent(in ) :: iLabel + integer(IntKi), intent( OUT) :: ErrStat !< Error status of the operation + character(*), intent( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! Solve for the residual of the constraint state functions here: + !z%residual = 0.0_ReKi + !z%Gamma_LL = 0.0_ReKi + call AllocAry( z_out%Gamma_LL, p%nSpan, p%nWings, 'Lifting line Circulation', ErrStat, ErrMsg ); + z_out%Gamma_LL = -999999_ReKi; + + CALL Wings_ComputeCirculation(t, z_out%Gamma_LL, z_guess%Gamma_LL, u, p, x, m, AFInfo, ErrStat, ErrMsg, iLabel) + +end subroutine FVW_CalcConstrStateResidual + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for computing outputs, used in both loose and tight coupling. +!! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. +!! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for +!! for a complete description of each output parameter. +! NOTE: no matter how many channels are selected for output, all of the outputs are calculated +! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are +! placed in the y%WriteOutput(:) array. +subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, 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 + 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_DiscreteStateType), intent(in ) :: xd !< Discrete states at t +!FIXME:TODO: AD15_CalcOutput has constraint states as intent(in) only. This is forcing me to store z in the AD15 miscvars for now. + 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 + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: iW, n, i0, i1, i2 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CalcOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + if (DEV_VERSION) then + print'(A,F10.3,A,L1,A,I0,A,I0)','CalcOutput t:',t,' ',m%FirstCall,' nNW:',m%nNW,' nFW:',m%nFW + endif + + ! Set the wind velocity at vortex + CALL DistributeRequestedWind(u%V_wind, p, m) + + ! if we are on a correction step, CalcOutput may be called again with different inputs + ! Compute m%Gamma_LL + CALL Wings_ComputeCirculation(t, m%Gamma_LL, z%Gamma_LL, u, p, x, m, AFInfo, ErrStat2, ErrMsg2, 0); if(Failed()) return ! For plotting only + + + ! Induction on the lifting line control point + ! Set m%Vind_LL + m%Vind_LL=-9999.0_ReKi + call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); if(Failed()) return + + ! Induction on the mesh points (AeroDyn nodes) + n=p%nSpan + y%Vind(1:3,:,:) = 0.0_ReKi + do iW=1,p%nWings + ! --- Linear interpolation for interior points and extrapolations at boundaries + call interpextrap_cp2node(m%s_CP_LL(:,iW), m%Vind_LL(1,:,iW), m%s_LL(:,iW), y%Vind(1,:,iW)) + call interpextrap_cp2node(m%s_CP_LL(:,iW), m%Vind_LL(2,:,iW), m%s_LL(:,iW), y%Vind(2,:,iW)) + call interpextrap_cp2node(m%s_CP_LL(:,iW), m%Vind_LL(3,:,iW), m%s_LL(:,iW), y%Vind(3,:,iW)) + enddo + + ! For plotting only + m%Vtot_ll = m%Vind_LL + m%Vwnd_LL - m%Vstr_ll + if (DEV_VERSION) then + call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') + call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') + endif + + ! --- Write to local VTK at fps requested + if (p%WrVTK==1) then + if (m%VTKStep==-1) then + m%VTKStep = 0 ! Has never been called, special handling for init + else + m%VTKStep = m%iStep+1 ! We use glue code step number for outputs + endif + if (m%FirstCall) then + call MKDIR('vtk_fvw') + endif + if ( ( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon ) then + m%VTKlastTime = t + if ((p%VTKCoord==2).or.(p%VTKCoord==3)) then + ! Hub reference coordinates, for export only, ALL VTK Will be exported in this coordinate system! + ! Note: hubOrientation and HubPosition are optional, but required for bladeFrame==TRUE + call WrVTK_FVW(p, x, z, m, 'vtk_fvw/'//trim(p%RootName)//'FVW_Hub', m%VTKStep, 9, bladeFrame=.TRUE., & + HubOrientation=real(u%HubOrientation,ReKi),HubPosition=real(u%HubPosition,ReKi)) + endif + if ((p%VTKCoord==1).or.(p%VTKCoord==3)) then + ! Global coordinate system, ALL VTK will be exported in global + call WrVTK_FVW(p, x, z, m, 'vtk_fvw/'//trim(p%RootName)//'FVW_Glb', m%VTKStep, 9, bladeFrame=.FALSE.) + endif + endif + endif + + +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_CalcOutput') + Failed = ErrStat >= AbortErrLev + end function Failed + +end subroutine FVW_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +! --- UA related, should be merged with AeroDyn +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine UA_Init_Wrapper(AFInfo, InitInp, interval, p, x, xd, OtherState, m, ErrStat, ErrMsg ) + use UnsteadyAero, only: UA_Init, UA_TurnOff_param + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data, temporary, for UA.. + type(FVW_InitInputType), intent(inout) :: InitInp !< Input data for initialization routine (inout so we can use MOVE_ALLOC) + real(DbKi), intent(inout) :: interval !< time interval + type(FVW_ParameterType), intent(inout) :: p !< Parameters + type(FVW_ContinuousStateType), intent(inout) :: x !< Initial continuous states + type(FVW_DiscreteStateType), intent(inout) :: xd !< Initial discrete states + type(FVW_OtherStateType), intent(inout) :: OtherState !< Initial other states + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! + type(UA_InitInputType) :: Init_UA_Data + type(UA_InputType) :: u_UA + type(UA_InitOutputType):: InitOutData_UA + integer :: i,j + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 + ErrStat = ErrID_None + ErrMsg = "" + + m%UA_Flag=InitInp%UA_Flag + ! --- Condensed version of BEMT_Init_Otherstate + allocate ( OtherState%UA_Flag( InitInp%numBladeNodes, InitInp%NumBlades ), STAT = ErrStat2 ) + OtherState%UA_Flag=m%UA_Flag + if ( m%UA_Flag ) then + ErrMsg2='Unsteady aerodynamic (`AFAeroMod>1`) cannot be used with the free wake code (`WakeMod=3`) for now.'; ErrStat2=ErrID_Fatal; + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'UA_Init_Wrapper'); return + + ! ---Condensed version of "BEMT_Set_UA_InitData" + allocate(Init_UA_Data%c(InitInp%numBladeNodes,InitInp%numBlades), STAT = errStat2) + do j = 1,InitInp%NumBlades; do i = 1,InitInp%numBladeNodes; + Init_UA_Data%c(i,j) = p%chord(i,j) ! NOTE: InitInp chord move-allocd to p + end do; end do + Init_UA_Data%dt = interval + Init_UA_Data%OutRootName = '' + Init_UA_Data%numBlades = InitInp%NumBlades + Init_UA_Data%nNodesPerBlade = InitInp%numBladeNodes + Init_UA_Data%NumOuts = 0 + Init_UA_Data%UAMod = InitInp%UAMod + Init_UA_Data%Flookup = InitInp%Flookup + Init_UA_Data%a_s = InitInp%a_s ! m/s + ! --- UA init + call UA_Init( Init_UA_Data, u_UA, m%p_UA, xd%UA, OtherState%UA, m%y_UA, m%m_UA, interval, InitOutData_UA, ErrStat2, ErrMsg2); if(Failed())return + m%p_UA%ShedEffect=.False. !< Important, when coupling UA wih vortex code, shed vorticity is inherently accounted for + ! --- Condensed version of "BEMT_CheckInitUA" + do j = 1,InitInp%numBlades; do i = 1,InitInp%numBladeNodes; ! Loop over blades and nodes + call UA_TurnOff_param(AFInfo(p%AFindx(i,j)), ErrStat2, ErrMsg2) + if (ErrStat2 /= ErrID_None) then + call WrScr( 'Warning: Turning off Unsteady Aerodynamics because '//trim(ErrMsg2)//' BladeNode = '//trim(num2lstr(i))//', Blade = '//trim(num2lstr(j)) ) + OtherState%UA_Flag(i,j) = .false. + end if + end do; end do; +#ifdef UA_OUTS + CALL OpenFOutFile ( 69, 'Debug.UA.out', errStat, errMsg ); IF (ErrStat >= AbortErrLev) RETURN + WRITE (69,'(/,A)') 'This output information was generated by FVW'// ' on '//CurDate()//' at '//CurTime()//'.' + WRITE (69,'(:,A20)', ADVANCE='no' ) 'Time' + do i=1,size(InitOutData_UA%WriteOutputHdr) + WRITE (69,'(:,A20)', ADVANCE='no' ) trim(InitOutData_UA%WriteOutputHdr(i)) + end do + write (69,'(A)') ' ' + WRITE (69,'(:,A20)', ADVANCE='no' ) '(s)' + do i=1,size(InitOutData_UA%WriteOutputUnt) + WRITE (69,'(:,A20)', ADVANCE='no' ) trim(InitOutData_UA%WriteOutputUnt(i)) + end do + write (69,'(A)') ' ' +#endif + call UA_DestroyInput( u_UA, ErrStat2, ErrMsg2 ); if(Failed())return + call UA_DestroyInitInput( Init_UA_Data, ErrStat2, ErrMsg2 ); if(Failed())return + call UA_DestroyInitOutput( InitOutData_UA, ErrStat2, ErrMsg2 ); if(Failed())return + + ! --- FVW specific + if (p%CirculationMethod/=idCircPolarData) then + ErrMsg2='Unsteady aerodynamic (`AFAeroMod>1`) is only available with a circulation solving using profile data (`CircSolvingMethod=1`)'; ErrStat2=ErrID_Fatal; + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'UA_Init_Wrapper'); return + endif + endif +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'UA_Init_Wrapper') + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine UA_Init_Wrapper + +subroutine UA_UpdateState_Wrapper(AFInfo, n, u, p, x, xd, OtherState, m, ErrStat, ErrMsg ) + use FVW_VortexTools, only: interpextrap_cp2node + use UnsteadyAero, only: UA_UpdateStates, UA_TurnOff_input + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data, temporary, for UA.. + integer(IntKi), intent(in ) :: n !< time step + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_InputType), intent(in ) :: u !< Inputs + type(FVW_ContinuousStateType), intent(inout) :: x !< Initial continuous states + type(FVW_DiscreteStateType), intent(inout) :: xd !< Initial discrete states + type(FVW_OtherStateType), intent(inout) :: OtherState !< Initial other states + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local + type(UA_InputType) :: u_UA + integer :: i,j + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 + real(ReKi), dimension(:,:), allocatable :: Vind_node + ErrStat = ErrID_None + ErrStat2 = ErrID_None + ErrMsg = "" + ErrMsg2 = "" + if (m%UA_Flag) then + + ! --- Induction on the lifting line control point + ! NOTE: this is expensive since it's an output for FVW but here we have to use it for UA + ! Set m%Vind_LL + m%Vind_LL=-9999.0_ReKi + call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'); if (ErrStat >= AbortErrLev) return + + allocate(Vind_node(3,1:p%nSpan+1)) + + ! --- Condensed version of BEMT_Update States + do j = 1,p%nWings + ! Induced velocity at Nodes (NOTE: we rely on storage done when computing Circulation) + if (m%nNW>1) then + call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(1,:,j), m%s_LL(:,j), Vind_node(1,:)) + call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(2,:,j), m%s_LL(:,j), Vind_node(2,:)) + call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(3,:,j), m%s_LL(:,j), Vind_node(3,:)) + else + Vind_node=0.0_ReKi + endif + + do i = 1,p%nSpan+1 + ! We only update the UnsteadyAero states if we have unsteady aero turned on for this node + if (OtherState%UA_Flag(i,j) .and. n > 0) then + !! ....... compute inputs to UA ........... + ! NOTE: To be consistent with CalcOutput we take Vwind_ND that was set using m%DisturbedInflow from AeroDyn.. + ! This is not clean, but done to be consistent, waiting for AeroDyn to handle UA + call AlphaVrel_Generic(u%WingsMesh(j)%Orientation(1:3,1:3,i), u%WingsMesh(j)%TranslationVel(1:3,i), Vind_node(:,i), m%Vwnd_ND(:,i,j), p%KinVisc, p%Chord(i,j), u_UA%U, u_UA%alpha, u_UA%Re) + m%m_UA%iBladeNode = i + m%m_UA%iBlade = j + u_UA%UserProp = 0 ! u1%UserProp(i,j) ! TODO + !! ....... check inputs to UA ........... + call UA_TurnOff_input(AFInfo(p%AFIndx(i,j)), u_UA, ErrStat2, ErrMsg2) + if (ErrStat2 /= ErrID_None) then + OtherState%UA_Flag(i,j) = .FALSE. + call WrScr( 'Warning: Turning off dynamic stall due to '//trim(ErrMsg2)//' '//trim(NodeText(i,j))) + else + ! COMPUTE: xd%UA, OtherState%UA + call UA_UpdateStates( i, j, u_UA, m%p_UA, xd%UA, OtherState%UA, AFInfo(p%AFIndx(i,j)), m%m_UA, ErrStat2, ErrMsg2 ) + if (ErrStat2 /= ErrID_None) then + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'//trim(NodeText(i,j))) + call WrScr(trim(ErrMsg)) + if (ErrStat >= AbortErrLev) return + end if + end if + end if + end do + end do + call UA_DestroyInput( u_UA, ErrStat2, ErrMsg2 ); + deallocate(Vind_node) + endif + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper') +contains + function NodeText(i,j) + integer(IntKi), intent(in) :: i ! node number + integer(IntKi), intent(in) :: j ! blade number + character(25) :: NodeText + NodeText = '(nd:'//trim(num2lstr(i))//' bld:'//trim(num2lstr(j))//')' + end function NodeText +end subroutine UA_UpdateState_Wrapper + +end module FVW diff --git a/modules/aerodyn/src/FVW_BiotSavart.f90 b/modules/aerodyn/src/FVW_BiotSavart.f90 new file mode 100644 index 0000000000..cb15a379ea --- /dev/null +++ b/modules/aerodyn/src/FVW_BiotSavart.f90 @@ -0,0 +1,430 @@ +module FVW_BiotSavart + + use NWTC_Library, only: ReKi, IntKi + use OMP_LIB ! wrap with #ifdef _OPENMP if this causes an issue + + implicit none + + real(ReKi),parameter :: PRECISION_UI = epsilon(1.0_ReKi)/100 !< NOTE assuming problem of size 1 + real(ReKi),parameter :: MIN_EXP_VALUE=-10.0_ReKi + real(ReKi),parameter :: MINDENOM=0.0_ReKi +! real(ReKi),parameter :: MINDENOM=1e-15_ReKi + real(ReKi),parameter :: MINNORM=1e-4 + + integer(IntKi), parameter :: idRegNone = 0 + integer(IntKi), parameter :: idRegRankine = 1 + integer(IntKi), parameter :: idRegLambOseen = 2 + integer(IntKi), parameter :: idRegVatistas = 3 + integer(IntKi), parameter :: idRegOffset = 4 + integer(IntKi), parameter :: idRegExp = 1 + integer(IntKi), parameter :: idRegCompact = 2 + integer(IntKi), parameter, dimension(5) :: idRegVALID = (/idRegNone,idRegRankine,idRegLambOseen,idRegVatistas,idRegOffset/) + integer(IntKi), parameter, dimension(3) :: idRegPartVALID = (/idRegNone,idRegExp,idRegCompact/) + + real(ReKi),parameter :: fourpi_inv = 0.25_ReKi / ACOS(-1.0_Reki ) + +contains + + +!> Induced velocity from one segment at one control points +subroutine ui_seg_11(DeltaPa, DeltaPb, SegGamma, RegFunction, RegParam1, Uind) + ! Input/output arguments + real(ReKi), dimension(3), intent(in) :: DeltaPa !< 3 x 1 Pcp-P1 [m] + real(ReKi), dimension(3), intent(in) :: DeltaPb !< 3 x 1 Pcp-P2 [m] + real(ReKi), intent(in) :: SegGamma !< Circulation [m^2/s] + integer, intent(in) :: RegFunction!< Regularization model + real(ReKi), intent(in) :: RegParam1 !< Regularization parameter (core radius) [m] + real(ReKi), dimension(3),intent(out) :: Uind !< Induced velocity (no side effects) [m/s] + ! Variables declaration + real(ReKi),dimension(3) :: crossprod !< + real(ReKi) :: denominator !< + real(ReKi) :: r_bar2 !< (r/rc)^2 + real(ReKi) :: Kv !< + real(ReKi) :: norm_a, norm_b !< + real(ReKi) :: norm2_r0 !< Squared length of the segment + real(ReKi) :: norm2_orth !< Squared distance orthogonal to the segment + real(ReKi) :: xa, ya, za, xb, yb, zb !< Coordinates of X-Xa and X-Xb + real(ReKi) :: exp_value !< + ! + Uind(1:3)=0.0_ReKi + xa=DeltaPa(1); ya=DeltaPa(2); za=DeltaPa(3) + xb=DeltaPb(1); yb=DeltaPb(2); zb=DeltaPb(3) + norm_a = sqrt(xa*xa + ya*ya + za*za) + norm_b = sqrt(xb*xb + yb*yb + zb*zb) + denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) ! |r1|*|r2|*(|r1|*|r2| + r1.r2) + if (denominator>PRECISION_UI) then + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + if (norm2_r0>PRECISION_UI) then ! segment of zero length + ! --- Far field TODO + ! --- Regularization (close field) + norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 + select case (RegFunction) ! + case ( idRegNone ) ! No vortex core model + Kv=1.0_ReKi + case ( idRegRankine ) ! Rankine + r_bar2 = norm2_orth/ RegParam1**2 + if (r_bar2<1) then + Kv=r_bar2 + else + Kv=1.0_ReKi + end if + case ( idRegLambOseen ) ! Lamb-Oseen + r_bar2 = norm2_orth/ RegParam1**2 + exp_value = -1.25643_ReKi*r_bar2 + if(exp_value Induced velocity from a list of segments defined by Connectivity (SegConnct) and Points (SegPoints) +!! NOTE: this function has side effects and expects Uind_out to be initialized! +!! The function can compute the velocity on part of the segments and part of the control points. +!! This feature is useful if some parallelization is used, while common storage vectors are used. +subroutine ui_seg(iCPStart, iCPEnd, CPs, & + iSegStart, iSegEnd, nSegTot, nSegPTot, SegPoints, SegConnct, SegGamma, & + RegFunction, RegParam, Uind_out) + real(ReKi), dimension(:,:), intent(in) :: CPs !< Control points (3 x nCPs++) + integer(IntKi), intent(in) :: iCPStart !< Index where we start in Control points array + integer(IntKi), intent(in) :: iCPEnd !< Index where we end in Control points array + real(ReKi), dimension(:,:), intent(in) :: SegPoints !< Segment points (3 x nSegPTot) + integer(IntKi), dimension(:,:), intent(in) :: SegConnct !< Connectivity, indices of segments points iSeg1, iSeg2, iDepth, iSpan + real(ReKi), dimension(:), intent(in) :: SegGamma !< Segment circulation (nSegTot) + integer(IntKi), intent(in) :: iSegStart !< Index in SegConnct, and SegGamma where we start + integer(IntKi), intent(in) :: iSegEnd !< Index in SegConnct, and SegGamma where we end + integer(IntKi), intent(in) :: nSegTot !< Total number of segments + integer(IntKi), intent(in) :: nSegPTot !< Total number of segment points + integer(IntKi), intent(in) :: RegFunction !< Regularization model + real(ReKi), dimension(:), intent(in) :: RegParam !< Regularization parameter (nSegTot) + real(ReKi), dimension(:,:) , intent(inout) :: Uind_out !< Induced velocity vector - Side effects!!! (3 x nCPs++) + ! Variables + integer(IntKi) :: icp, is + real(ReKi), dimension(3) :: Uind !< + real(ReKi), dimension(3) :: P1, P2 !< Extremities of a given segment + ! Variables declaration + real(ReKi),dimension(3) :: crossprod !< + real(ReKi) :: denominator !< + real(ReKi) :: r_bar2 !< (r/rc)^2 + real(ReKi) :: Kv !< + real(ReKi) :: norm_a, norm_b !< + real(ReKi) :: norm2_orth !< + real(ReKi) :: norm2_r0 !< Squared length of the segment d = (r1xr2)/r0 + real(ReKi) :: xa, ya, za, xb, yb, zb !< Coordinates of X-Xa and X-Xb + real(ReKi) :: exp_value !< + + ! Branching based on regularization model + ! NOTE: copy paste of code is done for optimization! + ! The only thing changing is the part labelled "regularization" + select case (RegFunction) + case ( idRegNone ) ! No vortex core + !$OMP PARALLEL default(shared) + !$OMP do private(icp,is,Uind,P1,P2,crossprod,denominator,Kv,norm_a,norm_b,norm2_r0,norm2_orth,xa,ya,za,xb,yb,zb) schedule(runtime) + do icp=iCPStart,iCPEnd ! loop on CPs + do is=iSegStart,iSegEnd ! loop on selected segments + Uind = 0.0_ReKi + P1 = SegPoints(1:3, SegConnct(1,is)) ! Segment extremity points + P2 = SegPoints(1:3, SegConnct(2,is)) + xa=CPs(1,icp)-P1(1); ya=CPs(2,icp)-P1(2); za=CPs(3,icp)-P1(3); + xb=CPs(1,icp)-P2(1); yb=CPs(2,icp)-P2(2); zb=CPs(3,icp)-P2(3); + norm_a = sqrt(xa*xa + ya*ya + za*za) + norm_b = sqrt(xb*xb + yb*yb + zb*zb) + denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) + ! --- Far field TODO + if (denominator>PRECISION_UI) then + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + if (norm2_r0>PRECISION_UI) then + ! --- Far field TODO + ! --- NO Regularization (close field) + Kv = SegGamma(is)*fourpi_inv*(norm_a+norm_b)/(denominator + MINDENOM) + Uind(1:3) = Kv*crossprod(1:3) + end if + end if + end if + Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) + end do ! Loop on segments + enddo ! Loop on control points + !$OMP END DO + !$OMP END PARALLEL + + case ( idRegRankine ) ! Rankine + !$OMP PARALLEL default(shared) + !$OMP do private(icp,is,Uind,P1,P2,crossprod,denominator,r_bar2,Kv,norm_a,norm_b,norm2_r0,norm2_orth,xa,ya,za,xb,yb,zb) schedule(runtime) + do icp=iCPStart,iCPEnd ! loop on CPs + do is=iSegStart,iSegEnd ! loop on selected segments + Uind = 0.0_ReKi + P1 = SegPoints(1:3, SegConnct(1,is)) ! Segment extremity points + P2 = SegPoints(1:3, SegConnct(2,is)) + xa=CPs(1,icp)-P1(1); ya=CPs(2,icp)-P1(2); za=CPs(3,icp)-P1(3); + xb=CPs(1,icp)-P2(1); yb=CPs(2,icp)-P2(2); zb=CPs(3,icp)-P2(3); + norm_a = sqrt(xa*xa + ya*ya + za*za) + norm_b = sqrt(xb*xb + yb*yb + zb*zb) + denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) + if (denominator>PRECISION_UI) then + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + if (norm2_r0>PRECISION_UI) then + ! --- Far field TODO + ! --- Regularization (close field) --- Rankine + norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 + r_bar2 = norm2_orth/ RegParam(is)**2 + if (r_bar2<1) then + Kv=r_bar2 + else + Kv=1.0_ReKi + end if + Kv = SegGamma(is)*fourpi_inv*Kv*(norm_a+norm_b)/(denominator + MINDENOM) + Uind(1:3) = Kv*crossprod(1:3) + end if + end if ! denominator size or distances too small + end if ! + Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) + end do ! Loop on segments + enddo ! Loop on control points + !$OMP END DO + !$OMP END PARALLEL + + case ( idRegLambOseen ) ! LambOseen + !$OMP PARALLEL default(shared) + !$OMP do private(icp,is,Uind,P1,P2,crossprod,denominator,r_bar2,Kv,norm_a,norm_b,norm2_r0,norm2_orth,xa,ya,za,xb,yb,zb,exp_value) schedule(runtime) + do icp=iCPStart,iCPEnd ! loop on CPs + do is=iSegStart,iSegEnd ! loop on selected segments + Uind = 0.0_ReKi + P1 = SegPoints(1:3, SegConnct(1,is)) ! Segment extremity points + P2 = SegPoints(1:3, SegConnct(2,is)) + xa=CPs(1,icp)-P1(1); ya=CPs(2,icp)-P1(2); za=CPs(3,icp)-P1(3); + xb=CPs(1,icp)-P2(1); yb=CPs(2,icp)-P2(2); zb=CPs(3,icp)-P2(3); + norm_a = sqrt(xa*xa + ya*ya + za*za) + norm_b = sqrt(xb*xb + yb*yb + zb*zb) + denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) + if (denominator>PRECISION_UI) then + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + if (norm2_r0>PRECISION_UI) then + ! --- Far field TODO + ! --- Regularization (close field) --- Lamb Oseen + norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 + r_bar2 = norm2_orth/ RegParam(is)**2 + exp_value = -1.25643_ReKi*r_bar2 + if(exp_valuePRECISION_UI) then + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + if (norm2_r0>PRECISION_UI) then + ! --- Far field TODO + ! --- Regularization (close field) --- Vatistas + norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 + r_bar2 = norm2_orth/RegParam(is)**2 + Kv = r_bar2/sqrt(1+r_bar2**2) + Kv = SegGamma(is)*fourpi_inv*Kv*(norm_a+norm_b)/(denominator + MINDENOM) + Uind(1:3) = Kv*crossprod(1:3) + end if + end if ! denominator size or distances too small + end if ! + Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) + end do ! Loop on segments + enddo ! Loop on control points + !$OMP END DO + !$OMP END PARALLEL + + case ( idRegOffset ) ! Denominator offset + !$OMP PARALLEL default(shared) + !$OMP do private(icp,is,Uind,P1,P2,crossprod,denominator,r_bar2,Kv,norm_a,norm_b,norm2_r0,norm2_orth,xa,ya,za,xb,yb,zb) schedule(runtime) + do icp=iCPStart,iCPEnd ! loop on CPs + do is=iSegStart,iSegEnd ! loop on selected segments + Uind = 0.0_ReKi + P1 = SegPoints(1:3, SegConnct(1,is)) ! Segment extremity points + P2 = SegPoints(1:3, SegConnct(2,is)) + xa=CPs(1,icp)-P1(1); ya=CPs(2,icp)-P1(2); za=CPs(3,icp)-P1(3); + xb=CPs(1,icp)-P2(1); yb=CPs(2,icp)-P2(2); zb=CPs(3,icp)-P2(3); + norm_a = sqrt(xa*xa + ya*ya + za*za) + norm_b = sqrt(xb*xb + yb*yb + zb*zb) + denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) + if (denominator>PRECISION_UI) then + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + if (norm2_r0>PRECISION_UI) then + ! --- Far field TODO + ! --- Regularization (close field) -- Offset + denominator = denominator+RegParam(is)**2*norm2_r0 + Kv = SegGamma(is)*fourpi_inv*(norm_a+norm_b)/(denominator + MINDENOM) + Uind(1:3) = Kv*crossprod(1:3) + end if + end if ! denominator size or distances too small + end if ! + Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) + end do ! Loop on segments + enddo ! Loop on control points + !$OMP END DO + !$OMP END PARALLEL + case default + print*,'[ERROR] Unknown RegFunction for segment',RegFunction + STOP + end select +end subroutine ui_seg + +!> Induced velocity from `nPart` particles at `nCPs` control points. The velocity gradient is not computed +subroutine ui_part_nograd(CPs, Part, Alpha, RegFunction, RegParam, UIout, nCPs, nPart) + integer(IntKi), intent(in) :: nCPs + integer(IntKi), intent(in) :: nPart + real(ReKi), dimension(:,:), intent(in) :: CPs !< Control points (3 x nCPs) + real(ReKi), dimension(:,:), intent(inout) :: UIout !< Induced velocity, with side effects! (3 x nCPs) + real(ReKi), dimension(:,:), intent(in) :: Part !< Particle positions (3 x nPart) + real(ReKi), dimension(:,:), intent(in) :: Alpha !< Particle intensity [m^3/s] (3 x nPart) omega dV= alpha + integer(IntKi), intent(in) :: RegFunction !< Regularization function + real(ReKi), dimension(:), intent(in) :: RegParam !< Regularization parameter (nPart) + real(ReKi), dimension(3) :: UItmp !< + real(ReKi), dimension(3) :: DP !< + integer :: icp,ip + ! TODO: inlining of regularization + !$OMP PARALLEL DEFAULT(SHARED) + !$OMP DO PRIVATE(icp,ip, DP, UItmp) schedule(runtime) + do icp=1,nCPs ! loop on CPs + do ip=1,nPart ! loop on particles + UItmp(1:3) = 0.0_ReKi + DP(1:3) = CPs(1:3,icp)-Part(1:3,ip) + call ui_part_nograd_11(DP, Alpha(1:3,ip), RegFunction , RegParam(ip), UItmp) + UIout(1:3,icp)=UIout(1:3,icp)+UItmp(1:3) + enddo! loop on particles + enddo ! loop CPs + !$OMP END DO + !$OMP END PARALLEL +end subroutine ui_part_nograd + +!> Induced velocity from 1 particle at 1 control point. The velocity gradient is not computed +subroutine ui_part_nograd_11(DeltaP, Alpha, RegFunction, RegParam, Ui) + real(ReKi), dimension(3), intent(out) :: Ui !< no side effects + real(ReKi), dimension(3), intent(in) :: DeltaP !< CP-PP "control point - particle point" + real(ReKi), dimension(3), intent(in) :: Alpha !< Particle intensity [m^2/s] alpha=om.dV + integer(IntKi), intent(in) :: RegFunction !< + real(ReKi), intent(in) :: RegParam !< + real(ReKi),dimension(3) :: C !< Cross product of Alpha and r + real(ReKi) :: E !< Exponential poart for the mollifider + real(ReKi) :: r3_inv !< + real(ReKi) :: rDeltaP !< norm , distance between point and particle + real(ReKi) :: ScalarPart !< the part containing the inverse of the distance, but not 4pi, Mollifier + rDeltaP=sqrt(DeltaP(1)**2+ DeltaP(2)**2+ DeltaP(3)**2)! norm + if (rDeltaP Velocity induced by one vortex quad on nCPs Control Points +subroutine ui_quad_n1(CPs, nCPs, P1, P2, P3, P4, Gamm, RegFunction, RegParam, Uind) + integer, intent(in) :: nCPs !< + real(ReKi), dimension(:,:), intent(in) :: CPs !< 3 x "nCPs"++ + real(ReKi), dimension(3), intent(in) :: P1,P2,P3,P4 !< Coordinates of vortex quadrilateral + real(ReKi), intent(in) :: Gamm + integer(IntKi) , intent(in) :: RegFunction !< Regularization model (e.g. LambOseen) + real(ReKi), intent(in) :: RegParam !< Regularization parameter [m] + real(ReKi), dimension(:,:), intent(inout) :: Uind !< side effects!!! 3 x "nCPs++" + real(ReKi), dimension(3) :: CP !< + real(ReKi), dimension(3) :: Uindtmp !< + real(ReKi), dimension(3) :: DP1 !< + real(ReKi), dimension(3) :: DP2 !< + integer :: icp + ! + !OMP PARALLEL DEFAULT(SHARED) + !OMP DO PRIVATE(icp,CP,Uindtmp,DP1,DP2) schedule(runtime) + do icp=1,nCPs + CP(1:3)=CPs(1:3,icp) + ! 1-2 segment + DP1=CP-P1; DP2=CP-P2; + call ui_seg_11 ( DP1, DP2, Gamm, RegFunction, RegParam, Uindtmp) + Uind(1:3,icp) = Uind(1:3,icp)+Uindtmp(1:3) + ! 3-4 segment + DP1=CP-P3; DP2=CP-P4; + call ui_seg_11 ( DP1, DP2, Gamm, RegFunction, RegParam, Uindtmp) + Uind(1:3,icp) = Uind(1:3,icp)+Uindtmp(1:3) + ! 2-3 segment + DP1=CP-P2; DP2=CP-P3; + call ui_seg_11 ( DP1, DP2, Gamm, RegFunction, RegParam, Uindtmp) + Uind(1:3,icp) = Uind(1:3,icp)+Uindtmp(1:3) + ! 4-1 segment + DP1=CP-P4; DP2=CP-P1; + call ui_seg_11 ( DP1, DP2, Gamm, RegFunction, RegParam, Uindtmp) + Uind(1:3,icp) = Uind(1:3,icp)+Uindtmp(1:3) + end do ! loop on CPs + !OMP END DO + !OMP END PARALLEL +end subroutine ui_quad_n1 + +end module FVW_BiotSavart diff --git a/modules/aerodyn/src/FVW_IO.f90 b/modules/aerodyn/src/FVW_IO.f90 new file mode 100644 index 0000000000..9dc0f23db9 --- /dev/null +++ b/modules/aerodyn/src/FVW_IO.f90 @@ -0,0 +1,411 @@ +module FVW_IO + + USE FVW_Types + USE FVW_Subs + use FVW_VortexTools + implicit none + +contains + +! ============================================================================== +!> Reads the input file for FVW +SUBROUTINE FVW_ReadInputFile( FileName, p, Inp, ErrStat, ErrMsg ) + character(len=*), intent(in) :: FileName !< Input file name for FVW + type( FVW_ParameterType ), intent(inout) :: p !< Parameters + type(FVW_InputFile), intent(out) :: Inp !< Data stored in the module's input file + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + character(1024) :: PriPath ! the path to the primary input file + character(1024) :: VTK_fps_line ! string to temporarially hold value of read line for VTK_fps + integer(IntKi) :: UnIn + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + ErrStat = ErrID_None + ErrMsg = "" + ! Open file + CALL GetNewUnit( UnIn ) + CALL OpenFInpfile(UnIn, TRIM(FileName), ErrStat2, ErrMsg2) + if (Check( ErrStat2 /= ErrID_None , 'Could not open input file')) return + CALL GetPath( FileName, PriPath ) ! Input files will be relative to the path where the primary input file is located. + !------------------------------------- HEADER --------------------------------------------------- + CALL ReadCom(UnIn, FileName, 'FVW input file header line 1', ErrStat2, ErrMsg2 ); if(Failed()) return + CALL ReadCom(UnIn, FileName, 'FVW input file header line 2', ErrStat2, ErrMsg2 ); if(Failed()) return + !------------------------ GENERAL OPTIONS ------------------------------------------- + CALL ReadCom (UnIn,FileName, '--- General option header' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadVarWDefault(UnIn,FileName,Inp%IntMethod ,'Integration method' ,'', idEuler1 , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%DTfvw ,'DTfvw' ,'', p%DTaero , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%FreeWakeStart ,'FreeWakeStart' ,'', 0.0_ReKi , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%FullCirculationStart,'FullCirculationStart','', real(20.0_ReKi*Inp%DTfvw,ReKi), ErrStat2,ErrMsg2); if(Failed())return + !------------------------ CIRCULATION SPECIFICATIONS ------------------------------------------- + CALL ReadCom(UnIn,FileName, '--- Circulation specification header' , ErrStat2, ErrMsg2 ); if(Failed()) return + CALL ReadVarWDefault(UnIn,FileName,Inp%CirculationMethod ,'CirculationMethod' ,'', idCircPolarData, ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%CircSolvConvCrit ,'CircSolvConvCrit ' ,'', 0.001 , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%CircSolvRelaxation,'CircSolvRelaxation','', 0.1 , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%CircSolvMaxIter ,'CircSolvMaxIter' ,'', 30 , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVar(UnIn,FileName,Inp%CirculationFile ,'CirculationFile' ,'',ErrStat2,ErrMsg2); if(Failed())return + !------------------------ WAKE OPTIONS ------------------------------------------- + CALL ReadCom (UnIn,FileName, '=== Separator' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadCom (UnIn,FileName, '--- Wake options header' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadCom (UnIn,FileName, '--- Wake extent header' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadVar (UnIn,FileName,Inp%nNWPanels ,'nNWPanels' ,'' , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVar (UnIn,FileName,Inp%nFWPanels ,'nFWPanels' ,'' , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%nFWPanelsFree ,'nFWPanelsFree' ,'', Inp%nFWPanels , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%FWShedVorticity ,'FWShedVorticity' ,'', .False. , ErrStat2,ErrMsg2); if(Failed())return + + CALL ReadCom (UnIn,FileName, '--- Wake regularization header' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadVarWDefault(UnIn,FileName,Inp%DiffusionMethod ,'DiffusionMethod' ,'',idDiffusionNone , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%RegDeterMethod ,'RegDeterMethod' ,'',idRegDeterManual, ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%RegFunction ,'RegFunction' ,'',idRegVatistas , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%WakeRegMethod ,'WakeRegMethod' ,'',idRegConstant , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVar (UnIn,FileName,Inp%WakeRegParam ,'WakeRegParam' ,'' , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVar (UnIn,FileName,Inp%WingRegParam ,'WingRegParam' ,'' , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%CoreSpreadEddyVisc ,'CoreSpreadEddyVisc','',100.0_ReKi , ErrStat2,ErrMsg2); if(Failed())return + + CALL ReadCom (UnIn,FileName, '--- Wake treatment header' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadVarWDefault(UnIn,FileName,Inp%TwrShadowOnWake ,'TwrShadowOnWake' ,'',.false. , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%ShearModel ,'ShearModel' ,'',idShearNone , ErrStat2,ErrMsg2); if(Failed())return + + CALL ReadCom (UnIn,FileName, '--- Speed up header ' , ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadVarWDefault(UnIn,FileName,Inp%VelocityMethod ,'VelocityMethod' ,'',idVelocityBasic , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%TreeBranchFactor ,'TreeBranchFactor' ,'',2.0_ReKi , ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%PartPerSegment ,'PartPerSegment' ,'', 1 , ErrStat2,ErrMsg2); if(Failed())return +! Inp%TwrShadowOnWake = .False. +! Inp%VelocityMethod = idVelocityBasic +! Inp%TreeBranchFactor = 3.0_ReKi +! Inp%PartPerSegment = 1 + !------------------------ OUTPUT OPTIONS ----------------------------------------- + CALL ReadCom (UnIn,FileName, '=== Separator' ,ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadCom (UnIn,FileName, '--- Output options header' ,ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadVarWDefault(UnIn,FileName,Inp%WrVTK , 'WrVTK' ,'', 0 ,ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%VTKBlades , 'VTKBlades' ,'', 1 ,ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%VTKCoord , 'VTKCoord' ,'', 1 ,ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVar (UnIn,FileName,VTK_fps_line , 'VTK_fps' ,'' ,ErrStat2,ErrMsg2); if(Failed())return + + ! --- Validation of inputs + if (PathIsRelative(Inp%CirculationFile)) Inp%CirculationFile = TRIM(PriPath)//TRIM(Inp%CirculationFile) + + if (Check(.not.(ANY(idCircVALID ==Inp%CirculationMethod)), 'Circulation method (CircSolvingMethod) not implemented: '//trim(Num2LStr(Inp%CirculationMethod)))) return + if (Check(.not.(ANY(idIntMethodVALID==Inp%IntMethod )) , 'Time integration method (IntMethod) not yet implemented. Use Euler 1st order method for now.')) return + if (Check(.not.(ANY(idDiffusionVALID==Inp%DiffusionMethod)) , 'Diffusion method (DiffusionMethod) not implemented: '//trim(Num2LStr(Inp%DiffusionMethod)))) return + if (Check(.not.(ANY(idRegDeterVALID ==Inp%RegDeterMethod)) , 'Regularization determination method (RegDeterMethod) not yet implemented: '//trim(Num2LStr(Inp%RegDeterMethod)))) return + if (Check(.not.(ANY(idRegVALID ==Inp%RegFunction )), 'Regularization function (RegFunction) not implemented: '//trim(Num2LStr(Inp%RegFunction)))) return + if (Check(.not.(ANY(idRegMethodVALID==Inp%WakeRegMethod)), 'Wake regularization method (WakeRegMethod) not implemented: '//trim(Num2LStr(Inp%WakeRegMethod)))) return + if (Check(.not.(ANY(idShearVALID ==Inp%ShearModel )), 'Shear model (ShearModel) not valid: '//trim(Num2LStr(Inp%ShearModel)))) return + if (Check(.not.(ANY(idVelocityVALID ==Inp%VelocityMethod )), 'Velocity method (VelocityMethod) not valid: '//trim(Num2LStr(Inp%VelocityMethod)))) return + + if (Check( Inp%DTfvw < p%DTaero, 'DTfvw must be >= DTaero from AD15.')) return + if (abs(Inp%DTfvw-p%DTaero)>epsilon(1.0_ReKi)) then + ! subcycling + if (Check(Inp%IntMethod/=idEuler1 , 'Sub-cycling (DTfvw>DTaro) is only possible with Forward Euler `IntMethod`')) return + endif + if (Inp%CirculationMethod == idCircPolarData) then + if (Check( Inp%nNWPanels<1 , 'Number of near wake panels (`nNWPanels`) must be >=1 when using circulation solving with polar data (`CircSolvingMethod=1`)')) return + endif + + if (Check( Inp%nNWPanels<0 , 'Number of near wake panels must be >=0')) return + if (Check( Inp%nFWPanels<0 , 'Number of far wake panels must be >=0')) return + if (Check( Inp%nFWPanelsFree<0 , 'Number of free far wake panels must be >=0')) return + if (Check( Inp%nFWPanelsFree>Inp%nFWPanels , 'Number of free far wake panels must be <=Number of far wake panels')) return + + if (Check(Inp%WakeRegParam<0 , 'Wake regularization parameter (WakeRegParam) should be positive')) return + if (Check(Inp%WingRegParam<0 , 'Wing regularization parameter (WakeRegParam) should be positive')) return + if (Check(Inp%CoreSpreadEddyVisc<0 , 'Core spreading eddy viscosity (CoreSpreadEddyVisc) should be positive')) return + + ! Removing the shed vorticity is a dangerous option if this is done too close to the blades. + ! To be safe, we will no matter what ensure that the last segments of NW are 0 if FWShedVorticity is False (see PackPanelsToSegments) + ! Still we force the user to be responsible. + if (Check((.not.(Inp%FWShedVorticity)) .and. Inp%nNWPanels<30, '`FWShedVorticity` should be true if `nNWPanels`<30. Alternatively, use a larger number of NWPanels ')) return + + Inp%DTvtk = Get_DTvtk( VTK_fps_line, p%DTaero, Inp%DTfvw ) + + ! At least one NW panel if FW, this shoudln't be a problem since the LL is in NW, but safety for now + !if (Check( (Inp%nNWPanels<=0).and.(Inp%nFWPanels>0) , 'At least one near wake panel is required if the number of far wake panel is >0')) return + call CleanUp() + +CONTAINS + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_ReadInputFile') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + logical function Check(Condition, ErrMsg_in) + logical, intent(in) :: Condition + character(len=*), intent(in) :: ErrMsg_in + Check=Condition + if (Check) then + call SetErrStat(ErrID_Fatal, 'Error in file '//TRIM(FileName)//': '//trim(ErrMsg_in), ErrStat, ErrMsg, 'FVW_ReadInputFile'); + call CleanUp() + endif + end function Check + + subroutine CleanUp() + close( UnIn ) + end subroutine + + real(DbKi) function Get_DTvtk( VTK_fps_line, DTaero, DTfvw ) + character(len=*), intent(inout) :: VTK_fps_line + real(DbKi), intent(in ) :: DTaero + real(DbKi), intent(in ) :: DTfvw + real(DbKi) :: VTK_fps + integer(IntKi) :: IOS + integer(IntKi) :: TmpRate + real(DbKi) :: TmpTime + + call Conv2UC( VTK_fps_line ) + if ( index(VTK_fps_line, "DEFAULT" ) == 1 ) then ! at DTfvw frequency + Get_DTvtk = DTfvw + elseif ( index(VTK_fps_line, "ALL" ) == 1 ) then ! at DTaero frequency + Get_DTvtk = DTaero + else ! read a number. Calculate this later. {will use closest integer multiple of DT} + read( VTK_fps_line, *, IOSTAT=IOS) VTK_fps + CALL CheckIOS ( IOS, FileName, 'VTK_fps', NumType, ErrStat2, ErrMsg2 ); if (Failed()) return; + + ! convert frames-per-second to seconds per sample: + if ( EqualRealNos(VTK_fps, 0.0_DbKi) ) then + Get_DTvtk = HUGE(1.0_DbKi) + else + TmpTime = 1.0_DbKi / VTK_fps + TmpRate = max( NINT( TmpTime / DTaero ),1_IntKi ) ! Can't be smaller that DTaero + Get_DTvtk = TmpRate * DTaero + ! warn if DTvtk is not TmpTime + if (.not. EqualRealNos(Get_DTvtk, TmpTime)) then + call SetErrStat(ErrID_Info, '1/VTK_fps is not an integer multiple of DT. FVW will output VTK information at '//& + trim(num2lstr(1.0_DbKi/(TmpRate*DTaero)))//' fps, the closest rate possible.',ErrStat,ErrMsg,'FVW_ReadInputFile') + end if + end if + end if + end function Get_DTvtk + + +END SUBROUTINE FVW_ReadInputFile + +!================================================= +!> Export FVW variables to VTK +!! NOTE: when entering this function nNW and nFW has been incremented by 1 +subroutine WrVTK_FVW(p, x, z, m, FileRootName, VTKcount, Twidth, bladeFrame, HubOrientation, HubPosition) + use FVW_VTK ! for all the vtk_* functions + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraints + type(FVW_MiscVarType), intent(in ) :: m !< MiscVars + character(*), intent(in) :: FileRootName !< Name of the file to write the output in (excluding extension) + integer(IntKi), intent(in) :: VTKcount !< Indicates number for VTK output file (when 0, the routine will also write reference information) + integer(IntKi), intent(in) :: Twidth !< Number of digits in the maximum write-out step (used to pad the VTK write-out in the filename with zeros) + logical, intent(in ) :: bladeFrame !< Output in blade coordinate frame + real(ReKi),optional,dimension(3,3), intent(in) :: HubOrientation + real(ReKi),optional,dimension(3) , intent(in) :: HubPosition + + ! local variables + integer:: iW + character(1024) :: FileName + character(255) :: Label + character(Twidth) :: Tstr ! string for current VTK write-out step (padded with zeros) + character(1), dimension(3) :: I2ABC =(/'A','B','C'/) + integer(IntKi) :: nSeg, nSegP, nSegNW + logical :: bMirror + !integer(IntKi) :: ErrStat2 + !character(ErrMsgLen) :: ErrMsg2 + real(Reki), dimension(:,:,:), allocatable :: dxdt_0 !< + + type(FVW_VTK_Misc) :: mvtk + + call vtk_misc_init(mvtk) + + if (bladeFrame) then + if (present(HubOrientation) .and. present(HubPosition)) then + call set_vtk_coordinate_transform(HubOrientation,HubPosition,mvtk) + else + Call ProgAbort('Programming error in WrVTK_FVW call: Cannot use the WrVTK_FVW with bladeFrame==TRUE without the optional arguments of HubOrientation and HubPosition') + endif + endif + + if (DEV_VERSION) then + print*,'------------------------------------------------------------------------------' + print'(A,L1,A,I0,A,I0,A,I0)','VTK Output - First call ',m%FirstCall, ' nNW:',m%nNW,' nFW:',m%nFW,' i:',VTKCount + endif + ! + call set_vtk_binary_format(.false.,mvtk) ! TODO binary fails + + ! TimeStamp + write(Tstr, '(i' // trim(Num2LStr(Twidth)) //'.'// trim(Num2LStr(Twidth)) // ')') VTKcount + + ! --------------------------------------------------------------------------------} + ! --- Blade + ! --------------------------------------------------------------------------------{ + ! --- Blade Quarter chord points (AC) + do iW=1,p%VTKBlades + write(Label,'(A,A)') 'BldPointCP.Bld', i2ABC(iW) + Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' + if ( vtk_new_ascii_file(trim(filename),Label,mvtk) ) then + call vtk_dataset_polydata(m%CP_LL(1:3,1:p%nSpan,iW),mvtk,bladeFrame) + call vtk_point_data_init(mvtk) + call vtk_point_data_scalar(m%Gamma_ll( 1:p%nSpan,iW),'Gamma_ll',mvtk) + call vtk_point_data_vector(m%Vind_ll (1:3,1:p%nSpan,iW),'Vind_ll',mvtk) + call vtk_point_data_vector(m%Vtot_ll (1:3,1:p%nSpan,iW),'Vtot_ll',mvtk) + call vtk_point_data_vector(m%Vstr_ll (1:3,1:p%nSpan,iW),'Vstr_ll',mvtk) + call vtk_point_data_vector(m%Vwnd_ll (1:3,1:p%nSpan,iW),'Vwnd_ll',mvtk) + call vtk_point_data_vector(m%Tang (1:3,1:p%nSpan,iW),'Tangent',mvtk) + call vtk_point_data_vector(m%Norm (1:3,1:p%nSpan,iW),'Normal',mvtk) + call vtk_point_data_vector(m%Orth (1:3,1:p%nSpan,iW),'Orth',mvtk) + call vtk_close_file(mvtk) + endif + enddo + ! --- Lifting line panels + do iW=1,p%VTKBlades + write(Label,'(A,A)') 'LL.Bld', i2ABC(iW) + Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' + call WrVTK_Lattice(FileName, mvtk, m%r_LL(1:3,:,:,iW), m%Gamma_LL(:,iW:iW), bladeFrame=bladeFrame) + enddo + ! --------------------------------------------------------------------------------} + ! --- Near wake + ! --------------------------------------------------------------------------------{ + ! --- Near wake panels + do iW=1,p%VTKBlades + write(Label,'(A,A)') 'NW.Bld', i2ABC(iW) + Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' + if (m%FirstCall) then ! Small Hack - At t=0, NW not set, but first NW panel is the LL panel + allocate(dxdt_0(3, size(m%dxdt_NW,2) , m%nNW+1)); dxdt_0=0.0_ReKi + call WrVTK_Lattice(FileName, mvtk, m%r_LL(1:3,:,1:2,iW), m%Gamma_LL(:,iW:iW),dxdt_0, bladeFrame=bladeFrame) + deallocate(dxdt_0) + else + call WrVTK_Lattice(FileName, mvtk, x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), m%dxdt_NW(:,:,1:m%nNW+1,iW), bladeFrame=bladeFrame) + endif + enddo + ! --------------------------------------------------------------------------------} + ! --- Far wake + ! --------------------------------------------------------------------------------{ + ! --- Far wake panels + do iW=1,p%VTKBlades + write(Label,'(A,A)') 'FW.Bld', i2ABC(iW) + Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' + call WrVTK_Lattice(FileName, mvtk, x%r_FW(1:3,1:FWnSpan+1,1:m%nFW+1,iW), x%Gamma_FW(1:FWnSpan,1:m%nFW,iW),m%dxdt_FW(:,:,1:m%nFW+1,iW), bladeFrame=bladeFrame) + enddo + ! --------------------------------------------------------------------------------} + ! --- All Segments + ! --------------------------------------------------------------------------------{ + ! NOTE: now we rely on the fact that the segments in Misc are well set + ! These segments are correct after a call to CalcOutput + ! The alternative is to call PackPanelsToSegments as was done before + ! This would require to allocate some local SegPoints,SegConnct here. + ! False below is to avoid writing the mirrored vorticity, this could be an option though + bMirror= (p%ShearModel==idShearMirror) .and. (p%VTKBlades<0) ! NOTE: temporary hack to output mirrored vorticity + call CountSegments(p, m%nNW, m%nFW, 1, nSeg, nSegP, nSegNW) + if (bMirror) then + nSeg = 2*nSeg + nSegP = 2*nSegP + endif + Filename = TRIM(FileRootName)//'.AllSeg.'//Tstr//'.vtk' + CALL WrVTK_Segments(Filename, mvtk, m%SegPoints(:,1:nSegP), m%SegConnct(:,1:nSeg), m%SegGamma(1:nSeg), m%SegEpsilon(1:nSeg), bladeFrame) + + if(.false.) print*,z%Gamma_LL(1,1) ! unused var for now +end subroutine WrVTK_FVW + + +subroutine WrVTK_Segments(filename, mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) + use FVW_VTK + character(len=*),intent(in) :: filename + type(FVW_VTK_Misc), intent(inout) :: mvtk !< miscvars for VTK output + real(ReKi), dimension(:,:), intent(in) :: SegPoints !< + integer(IntKi), dimension(:,:), intent(in) :: SegConnct !< + real(ReKi), dimension(:) , intent(in) :: SegGamma !< + real(ReKi), dimension(:) , intent(in) :: SegEpsilon !< + logical, intent(in ) :: bladeFrame !< Output in blade coordinate frame + if ( vtk_new_ascii_file(filename,'Sgmt',mvtk) ) then + call vtk_dataset_polydata(SegPoints(1:3,:),mvtk,bladeFrame) + call vtk_lines(SegConnct(1:2,:)-1,mvtk) ! NOTE: VTK indexing at 0 + call vtk_cell_data_init(mvtk) + call vtk_cell_data_scalar(SegGamma ,'Gamma',mvtk) + call vtk_cell_data_scalar(SegEpsilon,'Epsilon',mvtk) +! call vtk_cell_data_scalar(real(SegConnct(3,:), ReKi),'Age',mvtk) + !call vtk_cell_data_scalar(real(SegConnct(4,:), ReKi),'Span',mvtk) + call vtk_close_file(mvtk) + endif +end subroutine + +subroutine WrVTK_Lattice(filename, mvtk, LatticePoints, LatticeGamma, LatticeData3d, bladeFrame) + use FVW_VTK ! for all the vtk_* functions + character(len=*), intent(in) :: filename + type(FVW_VTK_Misc), intent(inout) :: mvtk !< miscvars for VTK output + real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Array of points 3 x nSpan x nDepth + real(Reki), dimension(:,:), intent(in ) :: LatticeGamma !< Array of nSpan x nDepth + real(Reki), dimension(:,:,:), intent(in ), optional :: LatticeData3d !< Array of n x nSpan x nDepth KEEP ME + logical, intent(in ) :: bladeFrame !< Output in blade coordinate frame + ! + integer(IntKi), dimension(:,:), allocatable :: Connectivity + real(ReKi), dimension(:,:), allocatable :: Points + + CALL LatticeToPanlConnectivity(LatticePoints, Connectivity, Points) + + if ( vtk_new_ascii_file(filename,'',mvtk)) then + call vtk_dataset_polydata(Points,mvtk,bladeFrame) + call vtk_quad(Connectivity,mvtk) + call vtk_cell_data_init(mvtk) + call vtk_cell_data_scalar(LatticeGamma,'Gamma',mvtk) + if (present(LatticeData3d)) then + call vtk_point_data_init(mvtk) + call vtk_point_data_vector(LatticeData3d,'Uconv',mvtk) + endif + call vtk_close_file(mvtk) + endif + +end subroutine WrVTK_Lattice + +subroutine LatticeToPanlConnectivity(LatticePoints, Connectivity, Points) + real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Array of points 3 x nSpan x nDepth + integer(IntKi), dimension(:,:), allocatable :: Connectivity + real(ReKi), dimension(:,:), allocatable :: Points + ! Local + integer(IntKi) :: nSpan, nDepth + integer(IntKi) :: iSpan, iDepth, k + nSpan = size(LatticePoints,2) + nDepth = size(LatticePoints,3) + + if (allocated(Connectivity)) deallocate(Connectivity) + allocate(Connectivity(1:4, 1:(nSpan-1)*(nDepth-1))) + if (allocated(Points)) deallocate(Points) + allocate(Points(1:3, 1:nSpan*nDepth)) + + k=1 + do iDepth=1,nDepth-1; do iSpan=1,nSpan-1 + Connectivity(1,k)=(iDepth-1)*nSpan+(iSpan-1) + Connectivity(2,k)=(iDepth-1)*nSpan+(iSpan ) + Connectivity(3,k)=(iDepth )*nSpan+(iSpan) + Connectivity(4,k)=(iDepth )*nSpan+(iSpan-1) + k=k+1 + enddo; enddo + + k=1 + do iDepth=1,nDepth; do iSpan=1,nSpan + Points(1:3,k) = LatticePoints(1:3,iSpan,iDepth) + k=k+1 + enddo; enddo + +! do iWing=1,p%NumBlades +! if ( vtk_new_ascii_file(trim(filename),Label,mvtk) ) then +! ! Buffer for points +! k=1; do iNW=1,nNW; do iSpan=1,nSpan +! Buffer(1:3,k) = Misc%NWake%r_nearj(1:3,iSpan,iNW,iWing) +! k=k+1 +! enddo; enddo +! call vtk_dataset_polydata(Buffer,mvtk) +! call vtk_quad(Connectivity) +! call vtk_cell_data_init() +! ! Buffer for Gammas m1 +! k=1; do iNW=1,(nNW-1); do iSpan=1,(nSpan-1) +! if (iSpan "" "" +################################################################################################################################## +include Registry_NWTC_Library.txt +usefrom AirfoilInfo_Registry.txt +usefrom UnsteadyAero_Registry.txt + + +##################### Registry for FVW ############### +# ..... PARAMETERS ............. +#FVW_ParameterType +typedef FVW/FVW ParameterType IntKi nWings - - - "Number of Wings" - +typedef ^ ^ IntKi nSpan - - - "TODO, should be defined per wing. Number of spanwise element" - +typedef ^ ^ IntKi AFindx :: - - "Index to the airfoils from AD15 [idx1= BladeNode, idx2=Blade number]" - +typedef ^ ^ ReKi Chord :: - - "Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number]" - +typedef ^ ^ IntKi nNWMax - - - "Maximum number of nw panels, per wing" - +typedef ^ ^ IntKi nFWMax - - - "Maximum number of fw panels, per wing" - +typedef ^ ^ IntKi nFWFree - - - "Number of fw panels that are free, per wing" - +typedef ^ ^ Logical FWShedVorticity - - - "Include shed vorticity in the far wake" - +typedef ^ ^ IntKi IntMethod - - - "Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1)" - +typedef ^ ^ ReKi FreeWakeStart - - - "Time when wake starts convecting (rolling up)" s +typedef ^ ^ ReKi FullCirculationStart - - - "Time when the circulation is full" s +typedef ^ ^ IntKi CirculationMethod - - - "Method to determine the circulation" - +typedef ^ ^ ReKi PrescribedCirculation : - - "Prescribed circulation on all lifting lines" "m/s" +typedef ^ ^ IntKi CircSolvMaxIter - - - "Maximum number of iterations for circulation solving" - +typedef ^ ^ ReKi CircSolvConvCrit - - - "Convergence criterion for circulation solving" - +typedef ^ ^ ReKi CircSolvRelaxation - - - "Relaxation factor for circulation solving" - +typedef ^ ^ IntKi CircSolvPolar - - - "(0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha)" - +typedef ^ ^ IntKi DiffusionMethod - - - "Diffusion method (None, CoreSpreading, PSE)" - +typedef ^ ^ ReKi CoreSpreadEddyVisc - - - "Eddy viscosity used in the core spreading method" +typedef ^ ^ IntKi RegDeterMethod - - - "Regularization determinatino method (manual, automatic)" - +typedef ^ ^ IntKi RegFunction - - - "Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart)" - +typedef ^ ^ IntKi WakeRegMethod - - - "Method for regularization (constant, stretching, age, etc.)" - +typedef ^ ^ ReKi WakeRegParam - - - "Initial value of the regularization parameter" +typedef ^ ^ ReKi WingRegParam - - - "Regularization parameter of the wing" +typedef ^ ^ IntKi ShearModel - - - "Option for shear modelling" +typedef ^ ^ Logical TwrShadowOnWake - - - "Include tower shadow effects on wake" +typedef ^ ^ IntKi VelocityMethod - - - "Velocity calculation method" +typedef ^ ^ ReKi TreeBranchFactor - - - "Factor used to determine if a point is far enough" +typedef ^ ^ IntKi PartPerSegment - - - "Number of particles per segment, e.g. for tree method" +typedef ^ ^ DbKi DTaero - - - "Time interval for calls calculations" s +typedef ^ ^ DbKi DTfvw - - - "Time interval for calculating wake induced velocities" s +typedef ^ ^ ReKi KinVisc - - - "Kinematic air viscosity" m^2/s +# Parametesr output options +typedef ^ ^ IntKi WrVTK - - - "Outputs VTK at each calcoutput call, even if main fst doesnt do it" - +typedef ^ ^ IntKi VTKBlades - - - "Outputs VTk for each blade 0=no blade, 1=Bld 1" - +typedef ^ ^ DbKi DTvtk - - - "DT between vtk writes" s +typedef ^ ^ IntKi VTKCoord - - - "Switch for VTK outputs coordinate system" - +typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - + +# ....... MiscVars ............ +# FVW_MiscVarType +typedef FVW/FVW MiscVarType Logical FirstCall - - - "True if this is the first call to update state (used in CalcOutput)" - +# Variables at wing extent +typedef ^ ^ ReKi LE ::: - - "Leading edge points" - +typedef ^ ^ ReKi TE ::: - - "Trailing edge points" - +typedef ^ ^ ReKi r_LL :::: - - "Position of the Lifting line panels" - +typedef ^ ^ ReKi s_LL :: - - "Spanwise coordinate of LL elements" m +typedef ^ ^ ReKi chord_LL :: - - "chord on LL nodes " m +# Variables at control point - Dimensions nSpan +typedef ^ ^ ReKi s_CP_LL :: - - "Spanwise coordinate of LL CP" m +typedef ^ ^ ReKi chord_CP_LL :: - - "chord on LL cp " m +typedef ^ ^ ReKi CP_LL ::: - - "Coordinates of LL CP" - +typedef ^ ^ ReKi Tang ::: - - "Unit Tangential vector on LL CP" - +typedef ^ ^ ReKi Norm ::: - - "Unit Normal vector on LL CP " - +typedef ^ ^ ReKi Orth ::: - - "Unit Orthogonal vector on LL CP" - +typedef ^ ^ ReKi dl ::: - - "Vector of elementary length along the LL" - +typedef ^ ^ ReKi Area :: - - "Area of each LL panel" - +typedef ^ ^ ReKi diag_LL :: - - "Diagonal length of each LL panel" - +typedef ^ ^ Reki Gamma_LL :: - - "Circulation on the wing lifting line (COPY of Constraint State)" - +typedef ^ ^ ReKi Vind_LL ::: - - "Induced velocity on lifting line control points" m/s +typedef ^ ^ ReKi Vtot_LL ::: - - "Total velocity on lifting line control points" m/s +typedef ^ ^ ReKi Vstr_LL ::: - - "Structural velocity on LL CP" m/s +typedef ^ ^ ReKi Vwnd_LL ::: - - "Wind on lifting line control points" m/s +typedef ^ ^ ReKi Vwnd_NW :::: - - "Wind on near wake panels" m/s +typedef ^ ^ ReKi Vwnd_FW :::: - - "Wind on far wake panels" m/s +typedef ^ ^ ReKi Vind_NW :::: - - "Induced velocity on near wake panels" m/s +typedef ^ ^ ReKi Vind_FW :::: - - "Induced velocity on far wake panels" m/s +typedef ^ ^ IntKi nNW - - - "Number of active near wake panels" - +typedef ^ ^ IntKi nFW - - - "Number of active far wake panels" - +typedef ^ ^ IntKi iStep - - - "Current step number used for update state" - +typedef ^ ^ IntKi VTKstep - - - "Current vtk output step number" - +typedef ^ ^ DbKi VTKlastTime - - - "Time the last VTK file set was written out" s +typedef ^ ^ ReKi r_wind :: - - "List of points where wind is requested for next time step" - +typedef ^ ^ ReKi PitchAndTwist :: - - "Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)]" rad +typedef ^ ^ Logical ComputeWakeInduced - - - "Compute induced velocities on this timestep" - +typedef ^ ^ DbKi OldWakeTime - - - "Time the wake induction velocities were last calculated" s +typedef ^ ^ ReKi tSpent - - - "Time spent in expensive Biot-Savart computation" s +typedef ^ ^ ReKi dxdt_NW :::: - - "State time derivatie, stored for subcylcing" - +typedef ^ ^ ReKi dxdt_FW :::: - - "State time derivatie, stored for subcylcing" - +# Convenient storage +typedef ^ ^ Reki alpha_LL :: - - "Angle of attack at lifting line CP, only computed with CircPolarData method" - +typedef ^ ^ Reki Vreln_LL :: - - "Norm of Vrel on the lifting line" - +# Segment storage (buffer) +typedef ^ ^ IntKi SegConnct :: - - "Connectivity of segments" - +typedef ^ ^ ReKi SegPoints :: - - "Points delimiting the segments" - +typedef ^ ^ ReKi SegGamma : - - "Segment circulations" - +typedef ^ ^ ReKi SegEpsilon : - - "Segment regularization parameter" - +# Wake rollup storage (buffer) +typedef ^ ^ ReKi CPs :: - - "Control points used for wake rollup computation" - +typedef ^ ^ ReKi Uind :: - - "Induced velocities obtained at control points" - +# for calculating outputs at blade nodes +typedef ^ ^ ReKi BN_AxInd :: - - "Axial induction [size: (NumBlNds,numBlades)]" - +typedef ^ ^ ReKi BN_TanInd :: - - "Tangential induction [size: (NumBlNds,numBlades)]" - +typedef ^ ^ ReKi BN_Vrel :: - - "Relative velocity [size: (NumBlNds,numBlades)]" m/s +typedef ^ ^ ReKi BN_alpha :: - - "Angle of attack [size: (NumBlNds,numBlades)]" rad +typedef ^ ^ ReKi BN_phi :: - - "angle between the plane of rotation and the direction of the local wind [size: (NumBlNds,numBlades)]" rad +typedef ^ ^ ReKi BN_Re :: - - "Reynolds number [size: (NumBlNds,numBlades)]" - +typedef ^ ^ ReKi BN_URelWind_s ::: - - "Relative wind velocity in section coordinates [size: (3,NumBlNds,numBlades)]" m/s +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_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" - +typedef ^ ^ ReKi BN_Cx :: - - "normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade" - +typedef ^ ^ ReKi BN_Cy :: - - "tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade" - + +# TODO UA - Should be part of AeroDyn +typedef ^ ^ UA_MiscVarType m_UA - - - "misc vars for UnsteadyAero" - +typedef ^ ^ UA_OutputType y_UA - - - "outputs from UnsteadyAero" - +typedef ^ ^ UA_ParameterType p_UA - - - "parameters for UnsteadyAero" - +typedef ^ ^ LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - +typedef ^ ^ ReKi Vwnd_ND ::: - - "InflowOnBlade (at nodes) values modified by tower influence. ONLY for UA" m/s + +# ........ Input ............ +# FVW_InputType +typedef FVW/FVW InputType MeshType WingsMesh : - - "Input Mesh defining position and orientation of wings" +typedef ^ ^ ReKi V_wind :: - - "Wind at requested points (r_wind)" - +typedef ^ ^ ReKi HubOrientation {3}{3} - - "Orientation of hub coordinate system (for output only)" - +typedef ^ ^ ReKi HubPosition {3} - - "Origin of hub (for output only)" - + +# ........ Output ............ +# FVW_OutputType +typedef FVW/FVW OutputType ReKi Vind ::: - - "TODO mesh - Induced velocity vector. " - +typedef ^ ^ ReKi Cl_KJ :: - - "Lift coefficient from circulation (Kutta-Joukowski)" - + +#.......... ContinuousStateType ...... +# FVW_ContinuousStateType +typedef FVW/FVW ContinuousStateType ReKi Gamma_NW ::: - - "Circulation of the near wake panels" - +typedef ^ ^ ReKi Gamma_FW ::: - - "Circulation of the far wake panels" - +typedef ^ ^ ReKi r_NW :::: - - "Position of the near wake panels" - +typedef ^ ^ ReKi r_FW :::: - - "Position of the far wake panels" - + + +#.......... DiscreteStateType ...... +# FVW_DiscreteStateType +typedef FVW/FVW DiscreteStateType ReKi NULL - - - "Empty to satisfy framework" - +# TODO UA +typedef ^ ^ UA_DiscreteStateType UA - - - "states for UnsteadyAero" - + +#.......... ConstraintStateType ...... +# FVW_ConstraintStateType +typedef FVW/FVW ConstraintStateType Reki residual - - "Residual" - +typedef ^ ^ Reki Gamma_LL :: - - "Circulation on the wing lifting line" - + +# ....... OtherStateType ............ +# FVW_OtherStateType +typedef FVW/FVW OtherStateType IntKi NULL - - - "Number of active near wake panels" - +# TODO UA +typedef ^ ^ UA_OtherStateType UA - - - "other states for UnsteadyAero" - +typedef ^ ^ Logical UA_Flag {:}{:} - - "logical flag indicating whether to use UnsteadyAero" - + + +#.......... InitInputType ...... +# FVW_InitInputType +typedef FVW/FVW InitInputType CHARACTER(1024) FVWFileName - - - "Main FVW input file name" - +typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ^ MeshType WingsMesh : - - "Input Mesh defining position and orientation of wings (nSpan+1) " - +typedef ^ ^ IntKi AFindx :: - - "Index to the airfoils from AD15 [idx1=BladeNode, idx2=Blade number]" - +typedef ^ ^ ReKi Chord :: - - "Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number]" - +typedef ^ ^ ReKi RElm : - - "radius of center of each element" - +typedef ^ ^ ReKi zHub : - - "Distance to hub for each blade" m +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 ^ ^ IntKi NumBlades - - - "Number of blades" - +typedef ^ ^ IntKi NumBladeNodes - - - "Number of nodes on each blade" - +typedef ^ ^ DbKi DTaero - - - "Time interval for calls (from AD15)" s +typedef ^ ^ ReKi KinVisc - - - "Kinematic air viscosity" m^2/s +# TODO UA - Should be part of AeroDyn +typedef ^ ^ IntKi UAMod - - - "Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema]" - +typedef ^ ^ LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - +typedef ^ ^ LOGICAL Flookup - - - "Use table lookup for f' and f'' " - +typedef ^ ^ ReKi a_s - - - "speed of sound" m/s + +#.......... InputFileType ...... +# FVW_InputFile +typedef FVW/FVW FVW_InputFile IntKi CirculationMethod - - - "Method to determine the circulation" - +typedef ^ ^ CHARACTER(1024) CirculationFile - - - "Prescribed circulation file" - +typedef ^ ^ IntKi CircSolvMaxIter - - - "Maximum number of iterations for circulation solving" - +typedef ^ ^ ReKi CircSolvConvCrit - - - "Convergence criterion for circulation solving" - +typedef ^ ^ ReKi CircSolvRelaxation - - - "Relaxation factor for circulation solving" - + +typedef ^ ^ IntKi IntMethod - - - "Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor)" - +typedef ^ ^ LOGICAL FreeWake - - - "Disable roll up, wake convects with wind only (flag)" - +typedef ^ ^ ReKi FreeWakeStart - - - "Time when wake starts convecting (rolling up)" s +typedef ^ ^ ReKi FullCirculationStart - - - "Time when the circulation is full" s +typedef ^ ^ DbKi DTfvw - - - "Time interval for calculating wake induced velocities" s +typedef ^ ^ IntKi CircSolvPolar - - - "(0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha)" - +typedef ^ ^ IntKi nNWPanels - - - "Number of nw panels" - +typedef ^ ^ IntKi nFWPanels - - - "Number of fw panels" - +typedef ^ ^ IntKi nFWPanelsFree - - - "Number of fw panels that are free" - +typedef ^ ^ Logical FWShedVorticity - - - "Include shed vorticity in the far wake" - +typedef ^ ^ IntKi DiffusionMethod - - - "Diffusion method (None, CoreSpreading, PSE)" - +typedef ^ ^ ReKi CoreSpreadEddyVisc - - - "Eddy viscosity used in the core spreading method" +typedef ^ ^ IntKi RegDeterMethod - - - "Regularization determinatino method (manual, automatic)" - +typedef ^ ^ IntKi RegFunction - - - "Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart)" - +typedef ^ ^ IntKi WakeRegMethod - - - "Method for regularization (constant, stretching, age, etc.)" - +typedef ^ ^ ReKi WakeRegParam - - - "Factor used in the regularization " +typedef ^ ^ ReKi WingRegParam - - - "Factor used in the regularization " +typedef ^ ^ IntKi ShearModel - - - "Option for shear modelling" +typedef ^ ^ Logical TwrShadowOnWake - - - "Include tower shadow effects on wake" +typedef ^ ^ IntKi VelocityMethod - - - "Velocity calculation method" +typedef ^ ^ ReKi TreeBranchFactor - - - "Factor used to determine if a point is far enough" +typedef ^ ^ IntKi PartPerSegment - - - "Number of particles per segment, e.g. for tree method" +typedef ^ ^ IntKi WrVTK - - - "Outputs VTK at each calcoutput call, even if main fst doesnt do it" - +typedef ^ ^ IntKi VTKBlades - - - "Outputs VTk for each blade 0=no blade, 1=Bld 1" - +typedef ^ ^ DbKi DTvtk - - - "Requested timestep between VTK outputs (calculated from the VTK_fps read in)" s +typedef ^ ^ IntKi VTKCoord - - - "Switch for VTK outputs coordinate system" - + +#.......... InitOutputType ...... +# FVW_InitOutputType +typedef FVW/FVW InitOutputType IntKi Null - - - "Empty parameter to satisfy framework" - + + + diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 new file mode 100644 index 0000000000..cdff226121 --- /dev/null +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -0,0 +1,1088 @@ +module FVW_SUBS + + use NWTC_LIBRARY + use FVW_TYPES + use FVW_VortexTools + use FVW_BiotSavart + + implicit none + + ! --- Module parameters + ! Circulation solving methods + integer(IntKi), parameter :: idCircPolarData = 1 + integer(IntKi), parameter :: idCircNoFlowThrough = 2 + integer(IntKi), parameter :: idCircPrescribed = 3 + integer(IntKi), parameter, dimension(2) :: idCircVALID = (/idCircPolarData, idCircPrescribed /) + ! Integration method + integer(IntKi), parameter :: idRK4 = 1 + integer(IntKi), parameter :: idAB4 = 2 + integer(IntKi), parameter :: idABM4 = 3 + integer(IntKi), parameter :: idPredictor= 4 + integer(IntKi), parameter :: idEuler1 = 5 + integer(IntKi), parameter, dimension(1) :: idIntMethodVALID = (/idEuler1 /) + ! Diffusion method + integer(IntKi), parameter :: idDiffusionNone = 0 + integer(IntKi), parameter :: idDiffusionCoreSpread = 1 + integer(IntKi), parameter :: idDiffusionPSE = 2 + integer(IntKi), parameter, dimension(1) :: idDiffusionVALID = (/idDiffusionNone /) + ! Regularization Method + integer(IntKi), parameter :: idRegConstant = 1 + integer(IntKi), parameter :: idRegStretching = 2 + integer(IntKi), parameter :: idRegAge = 3 + integer(IntKi), parameter, dimension(2) :: idRegMethodVALID = (/idRegConstant,idRegAge/) + ! Regularization determination method + integer(IntKi), parameter :: idRegDeterManual = 0 + integer(IntKi), parameter :: idRegDeterAuto = 1 + integer(IntKi), parameter, dimension(2) :: idRegDeterVALID = (/idRegDeterManual, idRegDeterAuto /) + ! Shear model + integer(IntKi), parameter :: idShearNone = 0 + integer(IntKi), parameter :: idShearMirror = 1 + integer(IntKi), parameter, dimension(2) :: idShearVALID = (/idShearNone, idShearMirror /) + ! Velocity calculation method + integer(IntKi), parameter :: idVelocityBasic = 1 + integer(IntKi), parameter :: idVelocityTree = 2 + integer(IntKi), parameter :: idVelocityPart = 3 + integer(IntKi), parameter, dimension(3) :: idVelocityVALID = (/idVelocityBasic, idVelocityTree, idVelocityPart /) + + real(ReKi), parameter :: CoreSpreadAlpha = 1.25643 + + ! Implementation + integer(IntKi), parameter :: iNWStart=2 !< Index in r%NW where the near wake start (if >1 then the Wing panels are included in r_NW) + integer(IntKi), parameter :: FWnSpan=1 !< Number of spanwise far wake panels ! TODO make it an input later + logical , parameter :: DEV_VERSION=.False. +contains + +!========================================================================== +!> Helper function for 1d interpolation (interp1d) +function interpolation_array( xvals, yvals, xi, nOut, nIn ) + integer nOut, nIn, arindx, ilo + real(ReKi), dimension( nOut ) :: interpolation_array, xi + real(ReKi), dimension( nIn ) :: xvals, yvals, tmp2, tmp3 + real(ReKi) :: tmp1 + ilo = 1 + DO arindx = 1, nOut + IF ( xi( arindx ) .LT. xvals( 1 )) THEN + interpolation_array( arindx ) = yvals( 1 ) + ( xi( arindx ) - xvals( 1 )) / & + & ( xvals( 2 ) - xvals( 1 )) * ( yvals( 2 ) - yvals( 1 )) + ELSE IF ( xi( arindx ) .GT. xvals( nIn )) THEN + interpolation_array( arindx ) = yvals( nIn - 1 ) + ( xi( arindx ) - & + & xvals( nIn - 1 )) / ( xvals( nIn ) - xvals( nIn - 1 )) * & + & ( yvals( nIn ) - yvals( nIn - 1 )) + ELSE + tmp1 = real( xi( arindx ), ReKi) + tmp2 = real( xvals , ReKi) + tmp3 = real( yvals , ReKi) + interpolation_array( arindx ) = InterpBinReal( tmp1, tmp2, tmp3, ilo, nIn ) + END IF + END DO +END FUNCTION interpolation_array +!========================================================================== + +! ===================================================================================== +!> Output blade circulation +subroutine Output_Gamma(CP, Gamma_LL, iWing, iStep, iLabel, iIter) + real( ReKi ), dimension( :, : ), intent(in ) :: CP !< Control Points + real( ReKi ), dimension( : ), intent(in ) :: Gamma_LL !< Circulation on the lifting line + integer( IntKi ), intent(in ) :: iWing !< Wing index + integer( IntKi ), intent(in ) :: iStep !< Call ID + integer( IntKi ), intent(in ) :: iLabel !< Call ID + integer( IntKi ), intent(in ) :: iIter !< Call ID + character(len=255) :: filename + integer :: i + integer :: iUnit + real(ReKi) :: norm + call GetNewUnit(iUnit) + ! TODO output folder + CALL MKDIR('Gamma') + write(filename,'(A,I0,A,I0,A,I0,A,I0,A)')'Gamma/Gamma_step',int(iStep),'_lab',iLabel,'_it',iIter,'_Wing',int(iWing),'.txt' + OPEN(unit = iUnit, file = trim(filename), status="unknown", action="write") + write(iUnit,'(A)') 'norm_[m],x_[m],y_[m],z_[m], Gamma_[m^2/s]' + do i=1,size(Gamma_LL) + norm=sqrt(CP(1,i)**2+CP(2,i)**2+CP(3,i)**2) + write(iUnit,'(E14.7,A,E14.7,A,E14.7,A,E14.7,A,E14.7)') norm,',', CP(1,i),',',CP(2,i),',',CP(3,i),',', Gamma_LL(i) + enddo + close(iUnit) +endsubroutine Output_Gamma +! ===================================================================================== +!> Read a delimited file containing a circulation and interpolate it on the requested Control Points +!! The input file is a delimited file with one line of header. +!! Each following line consists of two columns: r/R_[-] and Gamma_[m^2/s] +subroutine ReadAndInterpGamma(CirculationFileName, s_CP_LL, L, Gamma_CP_LL, ErrStat, ErrMsg) + character(len=*), intent(in ) :: CirculationFileName !< Input file to read + real(ReKi), dimension(:), intent(in ) :: s_CP_LL !< Spanwise location of the lifting CP [m] + real(ReKi), intent(in ) :: L !< Full span of lifting line + real(ReKi), dimension(:), intent(out ) :: Gamma_CP_LL !< Interpolated circulation of the LL CP + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local + integer(IntKi) :: nLines + integer(IntKi) :: i + integer(IntKi) :: iStat + integer(IntKi) :: iUnit + character(len=1054) :: line + real(ReKi), dimension(:), allocatable :: sPrescr, GammaPrescr !< Radius + ErrStat = ErrID_None + ErrMsg = '' + ! --- + call GetNewUnit(iUnit) + open(unit = iUnit, file = CirculationFileName) + nLines=line_count(iUnit)-1 + ! Read Header + read(iUnit,*, iostat=istat) line + ! Read table: s/L [-], GammaPresc [m^2/s] + allocate(sPrescr(1:nLines), GammaPrescr(1:nLines)) + do i=1,nLines + read(iUnit,*, iostat=istat) sPrescr(i), GammaPrescr(i) + sPrescr(i) = sPrescr(i) * L + GammaPrescr(i) = GammaPrescr(i) + enddo + close(iUnit) + if (istat/=0) then + ErrStat=ErrID_Fatal + ErrMsg='Error occured while reading Circulation file: '//trim(CirculationFileName) + return + endif + ! NOTE: TODO TODO TODO THIS ROUTINE PERFORMS NASTY EXTRAPOLATION, SHOULD BE PLATEAUED + Gamma_CP_LL = interpolation_array( sPrescr, GammaPrescr, s_CP_LL, size(s_CP_LL), nLines ) +contains + + !> Counts number of lines in a file + integer function line_count(iunit) + integer(IntKi), intent(in) :: iunit + character(len=1054) :: line + ! safety for infinite loop.. + integer(IntKi), parameter :: nline_max=100000000 ! 100 M + integer(IntKi) :: i + line_count=0 + do i=1,nline_max + line='' + read(iunit,'(A)',END=100)line + line_count=line_count+1 + enddo + if (line_count==nline_max) then + print*,'Error: maximum number of line exceeded' + endif + 100 if(len(trim(line))>0) then + line_count=line_count+1 + endif + rewind(iunit) + end function + +endsubroutine ReadAndInterpGamma +! ===================================================================================== + +! -------------------------------------------------------------------------------- +! --- Mapping functions +! -------------------------------------------------------------------------------- + +!> Make sure the First panel of the NW match the last panel of the Trailing edge +!! - Same position of points +!! - Same circulation +subroutine Map_LL_NW(p, m, z, x, ShedScale, ErrStat, ErrMsg ) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraints states + type(FVW_ContinuousStateType), intent(inout) :: x !< Continuous states + real(ReKi), intent(in) :: ShedScale !< Time scaling of shed vorticity + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(ReKi) :: Gamma_Prev, Gamma_new + ! Local + integer(IntKi) :: iSpan , iW + ErrStat = ErrID_None + ErrMsg = "" + + ! First panel of NW is the last lifting line panel + do iW = 1,p%nWings + do iSpan = 1,p%nSpan+1 + x%r_NW(1:3, iSpan, iNWStart-1, iW) = m%r_LL(1:3, iSpan, 1, iW) ! iAge=1 + x%r_NW(1:3, iSpan, iNWStart , iW) = m%r_LL(1:3, iSpan, 2, iW) ! iAge=2 + enddo + enddo + ! First panel of NW is the last lifting line panel + do iW = 1,p%nWings + do iSpan = 1,p%nSpan + x%Gamma_NW(iSpan, iNWStart-1, iW) = z%Gamma_LL(iSpan,iW) ! iAge=1 + enddo + enddo + ! Circulations are the same on both side of the TE + if (p%nNWMax>iNWStart-1) then + do iW = 1,p%nWings + do iSpan = 1,p%nSpan + x%Gamma_NW(iSpan, iNWStart , iW) = z%Gamma_LL(iSpan,iW) ! iAge=2 + enddo + enddo + endif + ! When subcycling, we make sure the new circulation progressively ramps up from the old one + ! NOTE: subcycling needs improvement. + ! Frequencies are introduced, even for prescribed circulation, when wake roll up is included + ! If the wake is not free, the convection velocity is constant and there is no issue. + ! As a test case, the elliptical wing with constant circulation can be used, with roll up + ! The error seems to be bigger near the tip/root for this case. + if(.false.) then + if ((ShedScale<1.0_ReKi) .and. (m%nNW>=3)) then + print*,'Scaling' + do iW = 1,p%nWings + do iSpan = 1,p%nSpan + Gamma_Prev = x%Gamma_NW(iSpan, iNWStart+1, iW) ! Previous circulation + Gamma_New = x%Gamma_NW(iSpan, iNWStart , iW) + x%Gamma_NW(iSpan, iNWStart , iW) = Gamma_New*ShedScale + (1.0_ReKi-ShedScale) * Gamma_Prev + enddo + enddo + endif + endif +end subroutine Map_LL_NW + +!> Map the last NW panel with the first FW panel +subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraints states + 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 + real(ReKi), dimension(p%nWings) :: FWGamma + integer(IntKi), parameter :: iAgeFW=1 !< we update the first FW panel + ErrStat = ErrID_None + ErrMsg = "" + + ! First Panel of Farwake has coordinates of last panel of near wake always + if (p%nFWMax>0) then + FWGamma(:)=0.0_ReKi + if (m%nNW==p%nNWMax) then + ! First circulation of Farwake is taken as the max circulation of last NW column + do iW=1,p%nWings + !FWGamma = sum(x%Gamma_NW(:,p%nNWMax,iW))/p%nSpan + FWGamma(iW) = maxval(x%Gamma_NW(:,p%nNWMax,iW)) + x%Gamma_FW(1:FWnSpan,iAgeFW,iW) = FWGamma(iW) + enddo + endif + + do iW=1,p%nWings + ! Find first point (in half span) where circulation is more than 0.1% of MaxGamma, call it the root + iRoot=1 + ! NOTE: this below won't work for a wing + ! Need to go from maxgamma location, and integrate spanwise position on both side to find location of tip and root vortex + !do while ((iRoot2)) then + ErrMsg='Error: FWnSpan>2 not implemented.' + ErrStat=ErrID_Fatal + return + endif + enddo + endif + if (.false.) print*,z%Gamma_LL(1,1) ! Just to avoid unused var warning +endsubroutine Map_NW_FW + +!> Propagate the positions and circulation one index forward (loop from end to start) +subroutine PropagateWake(p, m, z, x, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraints states + 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) :: iSpan, iAge, iW + ErrStat = ErrID_None + ErrMsg = "" + + ! -- Propagate far wake + do iW=1,p%nWings + do iAge=p%nFWMax+1,2,-1 ! + do iSpan=1,FWnSpan+1 + x%r_FW(1:3,iSpan,iAge,iW) = x%r_FW(1:3,iSpan,iAge-1,iW) + enddo + enddo + x%r_FW(1:3,1:FWnSpan+1,1,iW) = -999.9_ReKi ! Nullified + enddo + if (p%nFWMax>0) then + do iW=1,p%nWings + do iAge=p%nFWMax,2,-1 + do iSpan=1,FWnSpan + x%Gamma_FW(iSpan,iAge,iW) = x%Gamma_FW(iSpan,iAge-1,iW) + enddo + enddo + x%Gamma_FW(1,1:FWnSpan-1,iW) = -999.9_ReKi ! Nullified + enddo + endif + ! --- Propagate near wake + do iW=1,p%nWings + do iAge=p%nNWMax+1,iNWStart+1,-1 + do iSpan=1,p%nSpan+1 + x%r_NW(1:3,iSpan,iAge,iW) = x%r_NW(1:3,iSpan,iAge-1,iW) + enddo + enddo + x%r_NW(1:3,:,1:iNWStart,iW) = -999.9_ReKi ! Nullified + enddo + if (p%nNWMax>1) then + do iW=1,p%nWings + do iAge=p%nNWMax,iNWStart+1,-1 + do iSpan=1,p%nSpan + x%Gamma_NW(iSpan,iAge,iW) = x%Gamma_NW(iSpan,iAge-1,iW) + enddo + enddo + x%Gamma_NW(:,1:iNWStart,iW) = -999.9_ReKi ! Nullified + enddo + endif + + ! Temporary hack for sub-cycling since straight after wkae computation, the wake size will increase + ! So we do a "fake" propagation here + do iW=1,p%nWings + do iAge=p%nFWMax+1,2,-1 ! + do iSpan=1,FWnSpan+1 + m%dxdt_FW(1:3,iSpan,iAge,iW) = m%dxdt_FW(1:3,iSpan,iAge-1,iW) + enddo + enddo + !m%dxdt_FW(1:3,1:FWnSpan+1,1,iW) = -999999_ReKi ! Important not nullified. The best would be to map the last NW convection velocity for this first row. + enddo + do iW=1,p%nWings + do iAge=p%nNWMax+1,iNWStart+1,-1 + do iSpan=1,p%nSpan+1 + m%dxdt_NW(1:3,iSpan,iAge,iW) = m%dxdt_NW(1:3,iSpan,iAge-1,iW) + enddo + enddo + m%dxdt_NW(1:3,:,1:iNWStart,iW) = 0.0_ReKi ! Nullified, wing do no convect, handled by LL,NW mapping + enddo + + if (.false.) print*,m%nNW,z%Gamma_LL(1,1) ! Just to avoid unused var warning +end subroutine PropagateWake + + +subroutine print_x_NW_FW(p, m, x, label) + type(FVW_ParameterType), intent(in) :: p !< Parameters + type(FVW_MiscVarType), intent(in) :: m !< Initial misc/optimization variables + type(FVW_ContinuousStateType), intent(in) :: x !< Continuous states + character(len=*),intent(in) :: label + integer(IntKi) :: iAge + character(len=1):: flag + print*,'------------------------------------------------------------------' + print'(A,I0,A,I0)',' NW .....................iNWStart:',iNWStart,' nNW:',m%nNW + do iAge=1,p%nNWMax+1 + flag='X' + if ((iAge)<= m%nNW+1) flag='.' + print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' + print*,trim(label)//'x', x%r_NW(1, 1, iAge,1), x%r_NW(1, p%nSpan+1, iAge,1) + print*,trim(label)//'y', x%r_NW(2, 1, iAge,1), x%r_NW(2, p%nSpan+1, iAge,1) + print*,trim(label)//'z', x%r_NW(3, 1, iAge,1), x%r_NW(3, p%nSpan+1, iAge,1) + enddo + print'(A,I0)','FW <<<<<<<<<<<<<<<<<<<< nFW:',m%nFW + do iAge=1,p%nFWMax+1 + flag='X' + if ((iAge)<= m%nFW+1) flag='.' + print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' + print*,trim(label)//'x', x%r_FW(1, 1, iAge,1), x%r_FW(1, FWnSpan+1, iAge,1) + print*,trim(label)//'y', x%r_FW(2, 1, iAge,1), x%r_FW(2, FWnSpan+1, iAge,1) + print*,trim(label)//'z', x%r_FW(3, 1, iAge,1), x%r_FW(3, FWnSpan+1, iAge,1) + enddo + !print'(A,I0,A,I0)','dxdt NW .....................iNWStart:',iNWStart,' nNW:',m%nNW + !do iAge=1,p%nNWMax+1 + ! flag='X' + ! if ((iAge)<= m%nNW+1) flag='.' + ! print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' + ! print*,trim(label)//'x', m%dxdt_NW(1, 1, iAge,1), m%dxdt_NW(1, p%nSpan+1, iAge,1) + ! print*,trim(label)//'y', m%dxdt_NW(2, 1, iAge,1), m%dxdt_NW(2, p%nSpan+1, iAge,1) + ! print*,trim(label)//'z', m%dxdt_NW(3, 1, iAge,1), m%dxdt_NW(3, p%nSpan+1, iAge,1) + !enddo + !print'(A,I0)','dxdt FW <<<<<<<<<<<<<<<<<<<< nFW:',m%nFW + !do iAge=1,p%nFWMax+1 + ! flag='X' + ! if ((iAge)<= m%nFW+1) flag='.' + ! print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' + ! print*,trim(label)//'x', m%dxdt_FW(1, 1, iAge,1), m%dxdt_FW(1, FWnSpan+1, iAge,1) + ! print*,trim(label)//'y', m%dxdt_FW(2, 1, iAge,1), m%dxdt_FW(2, FWnSpan+1, iAge,1) + ! print*,trim(label)//'z', m%dxdt_FW(3, 1, iAge,1), m%dxdt_FW(3, FWnSpan+1, iAge,1) + !enddo +endsubroutine + + +! -------------------------------------------------------------------------------- +! --- PACKING/UNPACKING FUNCTIONS +! -------------------------------------------------------------------------------- +!> Establish the list of points where we will need the free stream +!! The r_wind array is allocated at initialization to the largest size possible. This is to +!! ensure that we do not violate requirements in the framework later for changing the size +!! of input and output arrays. +subroutine SetRequestedWindPoints(r_wind, x, p, m) + real(ReKi), dimension(:,:), allocatable, intent(inout) :: r_wind !< Position where wind is requested + type(FVW_ContinuousStateType), intent(inout) :: x !< States + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range + + ! Using array reshaping to ensure a given near or far wake point is always at the same location in the array. + ! NOTE: Maximum number of points are passed, whether they "exist" or not. + ! NOTE: InflowWind ignores points at (0,0,0) + !if (DEV_VERSION) then + ! ! Removing points that don't exist + ! !call print_x_NW_FW(p,m,x,'wind befr') + ! if (m%nNW<=p%nNWMax) then + ! x%r_NW(1:3, 1:p%nSpan+1, m%nNW+2:p%nNWMax+1, 1:p%nWings) = 0.0_ReKi + ! endif + ! if ( ((p%nNWMax<=1) .and. (m%nFW==0)) .or. ((m%nFW>0) .and. (m%nFW<=p%nFWMax))) then + ! x%r_FW(1:3, 1:FWnSpan+1, m%nFW+2:p%nFWMax+1, 1:p%nWings) = 0.0_ReKi + ! else + ! x%r_FW(1:3, 1:FWnSpan+1, m%nFW+1:p%nFWMax+1, 1:p%nWings) = 0.0_ReKi + ! endif + ! !call print_x_NW_FW(p,m,x,'wind after') + !endif + + ! --- LL CP + iP_start=1 + iP_end=p%nWings*p%nSpan + r_wind(1:3,iP_start:iP_end) = reshape( m%CP_LL(1:3,1:p%nSpan,1:p%nWings), (/ 3, p%nSpan*p%nWings /)) + ! --- NW points + iP_start=iP_end+1 + iP_end=iP_start-1+(p%nSpan+1)*(p%nNWMax+1)*p%nWings + r_wind(1:3,iP_start:iP_end) = reshape( x%r_NW(1:3,1:p%nSpan+1,1:p%nNWMax+1,1:p%nWings), (/ 3, (p%nSpan+1)*(p%nNWMax+1)*p%nWings /)) + ! --- FW points + if (p%nFWMax>0) then + iP_start=iP_end+1 + iP_end=iP_start-1+(FWnSpan+1)*(p%nFWMax+1)*p%nWings + r_wind(1:3,iP_start:iP_end) = reshape( x%r_FW(1:3,1:FWnSpan+1,1:p%nFWMax+1,1:p%nWings), (/ 3, (FWnSpan+1)*(p%nFWMax+1)*p%nWings /)) + endif + + !if (DEV_VERSION) then + ! ! Additional checks + ! if (any(r_wind(3,:)<=-99999_ReKi)) then + ! call print_x_NW_FW(p,m,x,'wind after') + ! print*,'Error in wind' + ! STOP + ! endif + ! ! Removing points that don't exist + ! if (m%nNW<=p%nNWMax) then + ! x%r_NW(1:3, 1:p%nSpan+1, m%nNW+2:p%nNWMax+1, 1:p%nWings) = -999999.0_ReKi + ! endif + ! if ( ((p%nNWMax<=1) .and. (m%nFW==0)) .or. ((m%nFW>0) .and. (m%nFW<=p%nFWMax))) then + ! x%r_FW(1:3, 1:FWnSpan+1, m%nFW+2:p%nFWMax+1, 1:p%nWings) =-999999.0_ReKi + ! else + ! x%r_FW(1:3, 1:FWnSpan+1, m%nFW+1:p%nFWMax+1, 1:p%nWings) =-999999.0_ReKi + ! endif + !endif + +end subroutine SetRequestedWindPoints + + +!> Set the requested wind into the correponding misc variables +subroutine DistributeRequestedWind(V_wind, p, m) + real(ReKi), dimension(:,:), intent(in ) :: V_wind !< Position where wind is requested + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range + + ! Using array reshaping to ensure a given near or far wake point is always at the same location in the array. + ! NOTE: Maximum number of points are passed, whether they "exist" or not. + ! --- LL CP + iP_start=1 + iP_end=p%nWings*p%nSpan + m%Vwnd_LL(1:3,1:p%nSpan,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, p%nSpan, p%nWings /)) + ! --- NW points + iP_start=iP_end+1 + iP_end=iP_start-1+(p%nSpan+1)*(p%nNWMax+1)*p%nWings + m%Vwnd_NW(1:3,1:p%nSpan+1,1:p%nNWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, p%nSpan+1, p%nNWMax+1, p%nWings/)) + ! --- FW points + if (p%nFWMax>0) then + iP_start=iP_end+1 + iP_end=iP_start-1+(FWnSpan+1)*(p%nFWMax+1)*p%nWings + m%Vwnd_FW(1:3,1:FWnSpan+1,1:p%nFWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, FWnSpan+1, p%nFWMax+1, p%nWings /)) + endif + +end subroutine DistributeRequestedWind + + +!> Count how many segments are needed to represent the Near wake and far wakes, starting at a given depth +subroutine CountSegments(p, nNW, nFW, iDepthStart, nSeg, nSegP, nSegNW) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent(in ) :: nNW !< Number of NW panels + integer(IntKi), intent(in ) :: nFW !< Number of FW panels + integer(IntKi), intent(in ) :: iDepthStart !< Index where we start packing for NW panels + integer(IntKi), intent( out) :: nSeg !< Total number of segments after packing + integer(IntKi), intent( out) :: nSegP !< Total number of segments points after packing + integer(IntKi), intent( out) :: nSegNW !< Total number of segments points for the near wake only + logical :: LastNWShed + ! If the FW contains Shed vorticity, we include the last shed vorticity from the NW, otherwise, we don't! + ! It's important not to include it, otherwise a strong vortex will be present there with no compensating vorticity from the FW + LastNWShed = (p%FWShedVorticity ) .or. ((.not.p%FWShedVorticity) .and. (nNW=0) then + nSegP = p%nWings * ( (p%nSpan+1)*(nNW-iDepthStart+2) ) + nSegNW = p%nWings * (2*(p%nSpan+1)*(nNW-iDepthStart+2)-(p%nSpan+1)-(nNW-iDepthStart+1+1)) + if (.not.LastNWShed) then + nSegNW = nSegNW - p%nWings * (p%nSpan) ! Removing last set of shed segments + endif + endif + nSeg=nSegNW + ! FW segments + if (nFW>0) then + nSegP = nSegP + p%nWings * ( (FWnSpan+1)*(nFW+1) ) + if (p%FWShedVorticity) then + nSeg = nSeg + p%nWings * (2*(FWnSpan+1)*(nFW+1)-(FWnSpan+1)-(nFW+1)) + else + nSeg = nSeg + p%nWings * ( (FWnSpan+1)*(nFW) ) ! No Shed vorticity + endif + endif +end subroutine CountSegments + +!> Count how many control points are convecting (needed to compute the wake convection) +pure integer(IntKi) function CountCPs(p, nNW, nFWEff) result(nCPs) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent(in ) :: nNW !< Number of NW panels + integer(IntKi), intent(in ) :: nFWEff !< Number of effective (ie. convecting) FW panels + nCPs = p%nWings * ( (p%nSpan+1)*(nNW+1) ) + if (nFWEff>0) nCPs = nCPs + p%nWings * ((FWnSpan+1)*(nFWEff+1) ) +end function CountCPs + + +subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoints, SegGamma, nSeg, nSegP) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + type(FVW_ContinuousStateType), intent(in ) :: x !< States + integer(IntKi), intent(in ) :: iDepthStart !< Index where we start packing for NW panels + logical, intent(in ) :: bMirror !< Mirror the vorticity wrt the ground + integer(IntKi),dimension(:,:), intent(inout) :: SegConnct !< Segment connectivity + real(ReKi), dimension(:,:), intent(inout) :: SegPoints !< Segment Points + real(ReKi), dimension(:) , intent(inout) :: SegGamma !< Segment Circulation + integer(IntKi), intent(out) :: nSeg !< Total number of segments after packing + integer(IntKi), intent(out) :: nSegP !< Total number of segments points after packing + ! Local + integer(IntKi) :: iHeadC, iHeadP, nC, nCNW, nP, iW, iHeadC_bkp, i, iMirror + logical :: LastNWShed + + ! If the FW contains Shed vorticity, we include the last shed vorticity form the NW, orhtwerise, we don't! + ! It's important not to include it, otherwise a strong vortex will be present there with no compensating vorticity from the FW + LastNWShed = (p%FWShedVorticity ) .or. ((.not.p%FWShedVorticity) .and. (m%nNW0) then + ! Nullifying for safety + SegConnct=-1 + SegPoints=-1 + SegGamma =-1 + ! + iHeadP=1 + iHeadC=1 + if (nCNW>0) then + do iW=1,p%nWings + CALL LatticeToSegments(x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .True., LastNWShed ) + enddo + endif + if (m%nFW>0) then + iHeadC_bkp = iHeadC + do iW=1,p%nWings + CALL LatticeToSegments(x%r_FW(1:3,:,1:m%nFW+1,iW), x%Gamma_FW(:,1:m%nFW,iW), 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity) + enddo + SegConnct(3,iHeadC_bkp:) = SegConnct(3,iHeadC_bkp:) + m%nNW ! Increasing iDepth (or age) to account for NW + endif + if (DEV_VERSION) then + ! Safety checks + if ((iHeadP-1)/=nP) then + print*,'PackPanelsToSegments: Number of points wrongly estimated',nP, iHeadP-1 + STOP ! Keep me. The check will be removed once the code is well established + endif + if ((iHeadC-1)/=nC) then + print*,'PackPanelsToSegments: Number of segments wrongly estimated',nC, iHeadC-1 + STOP ! Keep me. The check will be removed once the code is well established + endif + if (any(SegPoints(3,:)<-99._ReKi)) then + call print_x_NW_FW(p,m,x,'pack') + print*,'PackPanelsToSegments: some segments are NAN' + STOP ! Keep me. The check will be removed once the code is well established + endif + endif + nSeg = iHeadC-1 + nSegP = iHeadP-1 + + if (bMirror) then + ! Mirroring the segments directly + ! NOTE: an alternative is to handle this in the Biot-Savart law directly... + do i=1,nSeg + iMirror = i + nSeg + SegConnct(1:2, iMirror) = SegConnct(1:2, i) + nSegP ! Increased point indices + SegConnct(3:4, iMirror) = SegConnct(3:4, i) ! Span and age is copied + SegGamma(iMirror) = -SegGamma(i) ! Vorticity needs mirroring + enddo + do i=1,nSegP + iMirror = i + nSegP + SegPoints(1:2, iMirror) = SegPoints(1:2, i) ! Same x and y + SegPoints(3 , iMirror) = - SegPoints(3 , i) ! Mirror with respect to z=0 + enddo + ! We now have double the amount of segments and points + nSeg = nSeg*2 + nSegP = nSegP*2 + endif + else + nSeg = 0 + nSegP = 0 + endif +end subroutine PackPanelsToSegments + +!> Set up regularization parameter based on diffusion method and regularization method +!! NOTE: this should preferably be done at the "panel"/vortex sheet level +subroutine FVW_InitRegularization(p, m, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(inout) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + real(ReKi) :: ds_min, ds_max, ds_mean !< min,max and mean of spanwise sections + real(ReKi) :: c_min, c_max, c_mean !< min,max and mean of chord + real(ReKi) :: d_min, d_max, d_mean !< min,max and mean of panel diagonal + real(ReKi) :: RegParam + real(ReKi) :: Span !< "Blade span" + integer :: iW + ErrStat = ErrID_None + ErrMsg = "" + ! --- Compute min max and mean spanwise section lengths + iW =1 + ds_min = minval(m%s_ll(2:p%nSpan+1,iW)-m%s_ll(1:p%nSpan,iW)) + ds_max = maxval(m%s_ll(2:p%nSpan+1,iW)-m%s_ll(1:p%nSpan,iW)) + ds_mean = sum(m%s_ll(2:p%nSpan+1,iW)-m%s_ll(1:p%nSpan,iW))/(p%nSpan+1) + c_min = minval(m%chord_LL(:,iW)) + c_max = maxval(m%chord_LL(:,iW)) + c_mean = sum (m%chord_LL(:,iW))/(p%nSpan+1) + d_min = minval(m%diag_LL(:,iW)) + d_max = maxval(m%diag_LL(:,iW)) + d_mean = sum (m%diag_LL(:,iW))/(p%nSpan+1) + Span = m%s_ll(p%nSpan+1,iW)-m%s_ll(1,iW) + RegParam = ds_mean*2 + if (DEV_VERSION) then + write(*,'(A)')'-----------------------------------------------------------------------------------------' + write(*,'(A)')'Regularization Info' + write(*,'(A,1F8.4,A)') 'Span : ',Span + write(*,'(A,3F8.4,A)') 'Chord : ',c_min,c_mean,c_max,' (min, mean, max)' + write(*,'(A,3F8.4,A)') 'Spanwise discretization: ',ds_min,ds_mean,ds_max,' (min, mean, max)' + write(*,'(A,3F8.4,A)') 'Diagonal discretization: ',d_min,d_mean,d_max,' (min, mean, max)' + write(*,'(A,1F8.4)') 'RegParam (Recommended) : ',RegParam + write(*,'(A,1F8.4)') 'RegParam (Input ) : ',p%WakeRegParam + endif + if (p%RegDeterMethod==idRegDeterAuto) then + ! TODO this is beta + print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + print*,'!!! NOTE: using optmized wake regularization parameters is still a beta feature!' + print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + p%WakeRegMethod = idRegConstant + p%RegFunction = idRegVatistas + p%WakeRegParam = RegParam + p%WingRegParam = RegParam + p%CoreSpreadEddyVisc = 100 + write(*,'(A)' ) 'The following regularization parameters will be used:' + write(*,'(A,I0)' ) 'WakeRegMethod : ', p%WakeRegMethod + write(*,'(A,I0)' ) 'RegFunction : ', p%RegFunction + write(*,'(A,1F8.4)') 'WakeRegParam : ', p%WakeRegParam + write(*,'(A,1F8.4)') 'WingRegParam : ', p%WingRegParam + write(*,'(A,1F8.4)') 'CoreSpreadEddyVisc: ', p%CoreSpreadEddyVisc + endif + ! KEEP ME: potentially perform pre-computation here + !if (p%WakeRegMethod==idRegConstant) then + !else if (p%WakeRegMethod==idRegStretching) then + !else if (p%WakeRegMethod==idRegAge) then + !else + ! ErrStat = ErrID_Fatal + ! ErrMsg ='Regularization method not implemented' + !endif +end subroutine FVW_InitRegularization + + +!> Set up regularization parameter based on diffusion method and regularization method +!! NOTE: this should preferably be done at the "panel"/vortex sheet level +subroutine WakeRegularization(p, x, m, SegConnct, SegPoints, SegGamma, SegEpsilon, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + integer(IntKi),dimension(:,:) , intent(in ) :: SegConnct !< Segment connectivity + real(ReKi), dimension(:,:) , intent(in ) :: SegPoints !< Segment Points + real(ReKi), dimension(:) , intent(in ) :: SegGamma !< Segment Circulation + real(ReKi), dimension(:) , intent( out) :: SegEpsilon !< Segment regularization parameter + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: iSeg + real(ReKi) :: time + ErrStat = ErrID_None + ErrMsg = "" + + ! + if (p%WakeRegMethod==idRegConstant) then + SegEpsilon=p%WakeRegParam + + else if (p%WakeRegMethod==idRegStretching) then + ! TODO + ErrStat = ErrID_Fatal + ErrMsg ='Regularization method not implemented' + if (.false.) print*,m%nNW,x%r_NW(1,1,1,1),SegPoints(1,1),SegGamma(1) ! Needed in the future, Just to avoid unused var warning + + else if (p%WakeRegMethod==idRegAge) then + do iSeg=1,size(SegEpsilon,1) ! loop on segments + time = (SegConnct(3, iSeg)-1) * p%DTfvw ! column 3 contains "iDepth", or "iAge", from 1 to nSteps + SegEpsilon(iSeg) = sqrt( 4._ReKi * CoreSpreadAlpha * p%CoreSpreadEddyVisc * p%KinVisc* time + p%WakeRegParam**2 ) + enddo + + else + ErrStat = ErrID_Fatal + ErrMsg ='Regularization method not implemented' + endif + +end subroutine WakeRegularization + + +!> Compute induced velocities from all vortex elements onto all the vortex elements +!! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW +!! Out: m%Vind_NW, m%Vind_FW +subroutine WakeInducedVelocities(p, x, m, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: iW, nSeg, nSegP, nCPs, iHeadP + integer(IntKi) :: nFWEff ! Number of farwake panels that are free at current tmie step + logical :: bMirror ! True if we mirror the vorticity wrt ground + ! TODO new options + integer(IntKi) :: RegFunctionPart + integer(IntKi) :: nPart + real(ReKi) :: DistanceDirect ! Distance under which direct evaluation of the Biot-Savart should be done for tree + type(T_Tree) :: Tree + real(ReKi), dimension(:,:), allocatable :: PartPoints !< Particle points + real(ReKi), dimension(:,:), allocatable :: PartAlpha !< Particle circulation + real(ReKi), dimension(:) , allocatable :: PartEpsilon !< Regularization parameter + ErrStat= ErrID_None + ErrMsg ='' + + nFWEff = min(m%nFW, p%nFWFree) + bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground + + m%Vind_NW = -9999._ReKi !< Safety + m%Vind_FW = -9999._ReKi !< Safety + + ! --- Packing all vortex elements into a list of segments + ! NOTE: modifies m%Seg* + call PackPanelsToSegments(p, m, x, 1, bMirror, m%SegConnct, m%SegPoints, m%SegGamma, nSeg, nSegP) + + ! --- Setting up regularization SegEpsilon + call WakeRegularization(p, x, m, m%SegConnct, m%SegPoints, m%SegGamma, m%SegEpsilon(1:nSeg), ErrStat, ErrMsg) + + ! --- Computing induced velocity + call PackConvectingPoints() + if (DEV_VERSION) then + print'(A,I0,A,I0,A,I0)','Convection - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs + endif + + ! --- Converting to particles + if ((p%VelocityMethod==idVelocityTree) .or. (p%VelocityMethod==idVelocityPart)) then + iHeadP=1 + nPart = p%PartPerSegment * nSeg + allocate(PartPoints(3,nPart), PartAlpha(3,nPart), PartEpsilon(nPart)) + PartAlpha(:,:) = -99999.99_ReKi + PartPoints(:,:) = -99999.99_ReKi + PartEpsilon(:) = -99999.99_ReKi + call SegmentsToPart(m%SegPoints, m%SegConnct, m%SegGamma, m%SegEpsilon, 1, nSeg, p%PartPerSegment, PartPoints, PartAlpha, PartEpsilon, iHeadP) + if (p%RegFunction/=idRegNone) then + RegFunctionPart = idRegExp ! TODO need to find a good equivalence and potentially adapt Epsilon in SegmentsToPart + endif + if (any(PartEpsilon(:)<-9999.99_ReKi)) then + print*,'Error in Segment to part conversion' + STOP + endif + endif + + ! --- Getting induced velocity + m%Uind=0.0_ReKi ! very important due to side effects of ui_* methods + if (p%VelocityMethod==idVelocityBasic) then + call ui_seg( 1, nCPs, m%CPs, 1, nSeg, nSeg, nSegP, m%SegPoints, m%SegConnct, m%SegGamma, p%RegFunction, m%SegEpsilon, m%Uind) + + elseif (p%VelocityMethod==idVelocityTree) then + + DistanceDirect = 2*sum(PartEpsilon)/size(PartEpsilon) ! 2*mean(eps), below that distance eps has a strong effect + call grow_tree(Tree, PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, 0) + !call print_tree(Tree) + call ui_tree(Tree, m%CPs, 0, 1, nCPs, p%TreeBranchFactor, DistanceDirect, m%Uind, ErrStat, ErrMsg) + call cut_tree(Tree) + deallocate(PartPoints, PartAlpha, PartEpsilon) + + elseif (p%VelocityMethod==idVelocityPart) then + call ui_part_nograd(m%CPs ,PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, m%Uind, nCPs, nPart) + deallocate(PartPoints, PartAlpha, PartEpsilon) + endif + call UnPackInducedVelocity() + +contains + !> Pack all the points that convect + subroutine PackConvectingPoints() + ! Counting total number of control points that convects + nCPs = CountCPs(p, m%nNW, nFWEff) + m%CPs=-999.9_ReKi + ! Packing + iHeadP=1 + do iW=1,p%nWings + CALL LatticeToPoints(x%r_NW(1:3,:,1:m%nNW+1,iW), 1, m%CPs, iHeadP) + enddo + if (nFWEff>0) then + do iW=1,p%nWings + CALL LatticeToPoints(x%r_FW(1:3,:,1:nFWEff+1,iW), 1, m%CPs, iHeadP) + enddo + endif + if (DEV_VERSION) then + ! Additional checks + if (any(m%CPs(1,1:nCPs)<=-99)) then + call print_x_NW_FW(p,m,x,'pack') + ErrMsg='PackConvectingPoints: Problem in Control points'; ErrStat=ErrID_Fatal; return + endif + if ((iHeadP-1)/=nCPs) then + print*,'PackConvectingPoints: Number of points wrongly estimated',nCPs, iHeadP-1 + STOP ! Keep me. The check will be removed once the code is well established + ErrMsg='PackConvectingPoints: Number of points wrongly estimated '; ErrStat=ErrID_Fatal; return + endif + endif + end subroutine + !> Distribute the induced velocity to the proper location + subroutine UnPackInducedVelocity() + iHeadP=1 + do iW=1,p%nWings + CALL VecToLattice(m%Uind, 1, m%Vind_NW(:,:,1:m%nNW+1,iW), iHeadP) + enddo + if (nFWEff>0) then + do iW=1,p%nWings + CALL VecToLattice(m%Uind, 1, m%Vind_FW(1:3,1:FWnSpan+1,1:nFWEff+1,iW), iHeadP) + enddo + if (DEV_VERSION) then + if (any(m%Vind_FW(1:3,1:FWnSpan+1,1:nFWEff+1,:)<-99)) then + ErrMsg='UnPackInducedVelocity: Problem in FW induced velocity on FW points'; ErrStat=ErrID_Fatal; return + endif + endif + endif + if (DEV_VERSION) then + if ((iHeadP-1)/=nCPs) then + print*,'UnPackInducedVelocity: Number of points wrongly estimated',nCPs, iHeadP-1 + STOP ! Keep me. The check will be removed once the code is well established + ErrMsg='UnPackInducedVelocity: Number of points wrongly estimated'; ErrStat=ErrID_Fatal; return + endif + endif + end subroutine + +end subroutine + +!> Compute induced velocities from all vortex elements onto the lifting line control points +!! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW +!! Out: m%Vind_LL +subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + integer(IntKi), intent(in ) :: iDepthStart !< Index where we start packing for NW panels + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + ! Local variables + integer(IntKi) :: iW, nSeg, nSegP, nCPs, iHeadP + real(ReKi), dimension(:,:), allocatable :: CPs !< ControlPoints + real(ReKi), dimension(:,:), allocatable :: Uind !< Induced velocity + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + logical :: bMirror + ErrStat = ErrID_None + ErrMsg = "" + m%Vind_LL = -9999._ReKi !< Safety + bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground + + ! --- Packing all vortex elements into a list of segments + call PackPanelsToSegments(p, m, x, iDepthStart, bMirror, m%SegConnct, m%SegPoints, m%SegGamma, nSeg, nSegP) + + ! --- Computing induced velocity + if (nSegP==0) then + nCPs=0 + m%Vind_LL = 0.0_ReKi + if (DEV_VERSION) then + print'(A,I0,A,I0,A,I0,A)','Induction - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs, ' -> No induction' + endif + else + ! --- Setting up regularization + call WakeRegularization(p, x, m, m%SegConnct(:,1:nSeg), m%SegPoints(:,1:nSegP), m%SegGamma(1:nSeg), m%SegEpsilon(1:nSeg), ErrStat, ErrMsg) + + nCPs=p%nWings * p%nSpan + allocate(CPs (1:3,1:nCPs)) ! NOTE: here we do allocate CPs and Uind insteadof using Misc + allocate(Uind(1:3,1:nCPs)) ! The size is reasonably small, and m%Uind then stay filled with "rollup velocities" (for export) + Uind=0.0_ReKi !< important due to side effects of ui_seg + ! --- + call PackLiftingLinePoints() + if (DEV_VERSION) then + print'(A,I0,A,I0,A,I0)','Induction - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs + endif + call ui_seg( 1, nCPs, CPs, 1, nSeg, nSeg, nSegP, m%SegPoints, m%SegConnct, m%SegGamma, p%RegFunction, m%SegEpsilon, Uind) + call UnPackLiftingLineVelocities() + + deallocate(Uind) + deallocate(CPs) + endif +contains + !> Pack all the control points + subroutine PackLiftingLinePoints() + iHeadP=1 + do iW=1,p%nWings + CALL LatticeToPoints(m%CP_LL(1:3,:,iW:iW), 1, CPs, iHeadP) + enddo + if (DEV_VERSION) then + if ((iHeadP-1)/=size(CPs,2)) then + print*,'PackLLPoints: Number of points wrongly estimated',size(CPs,2), iHeadP-1 + STOP ! Keep me. The check will be removed once the code is well established + endif + endif + nCPs=iHeadP-1 + end subroutine + + !> Distribute the induced velocity to the proper location + subroutine UnPackLiftingLineVelocities() + iHeadP=1 + do iW=1,p%nWings + CALL VecToLattice(Uind, 1, m%Vind_LL(1:3,:,iW:iW), iHeadP) + enddo + if (DEV_VERSION) then + if ((iHeadP-1)/=size(Uind,2)) then + print*,'UnPackLiftingLineVelocities: Number of points wrongly estimated',size(Uind,2), iHeadP-1 + STOP ! Keep me. The check will be removed once the code is well established + endif + endif + end subroutine +end subroutine + +!> Fake ground effect handling to prevents vortices to enter the ground +!! For now a crude bounding is done, engineering models may follow +!! True account of the ground effect (using mirroring or panels) should be done elsewhere +!! This assumes that the ground is at z=0, in harmony with inflow wind +subroutine FakeGroundEffect(p, x, m, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(inout) :: x !< States + type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: iAge, iWing, iSpan + integer(IntKi) :: nBelow + real(ReKi), parameter:: GROUND = 1.e-4_ReKi + real(ReKi), parameter:: ABOVE_GROUND = 0.1_ReKi + ErrStat = ErrID_None + ErrMsg = "" + + nBelow=0 + do iWing = 1,p%nWings + do iAge = 1,m%nNW+1 + do iSpan = 1,p%nSpan+1 + if (x%r_NW(3, iSpan, iAge, iWing) < GROUND) then + x%r_NW(3, iSpan, iAge, iWing) = ABOVE_GROUND ! could use m%dxdt + nBelow=nBelow+1 + endif + enddo + enddo + enddo + if (m%nFW>0) then + do iWing = 1,p%nWings + do iAge = 1,m%nFW+1 + do iSpan = 1,FWnSpan + if (x%r_FW(3, iSpan, iAge, iWing) < GROUND) then + x%r_FW(3, iSpan, iAge, iWing) = ABOVE_GROUND ! could use m%dxdt + nBelow=nBelow+1 + endif + enddo + enddo + enddo + endif + if (nBelow>0) then + print*,'[WARN] Check the simulation, some vortices were found below the ground: ',nBelow + endif +end subroutine FakeGroundEffect + +!> Compute typical aerodynamic outputs based on: +!! - the lifting line velocities in global coordinates +!! - some transformation matrices +!! - M_ag : from global to airfoil (this is well defined, also called "n-t" system in AeroDyn) +!! - M_sg : from global to section (this is ill-defined), this coordinate is used to define the "axial" and "tangential" inductions +subroutine FVW_AeroOuts( M_sg, M_ag, PitchAndTwist, Vstr_g, Vind_g, Vwnd_g, KinVisc, Chord, & + AxInd, TanInd, Vrel_norm, phi, alpha, Re, Urel_s, ErrStat, ErrMsg ) + real(ReKi), intent(in ) :: M_sg(3,3) ! m%WithoutSweepPitchTwist global coord to "section" coord + real(R8Ki), intent(in ) :: M_ag(3,3) ! u%BladeMotion(k)%Orientation(1:3,1:3,j) global coord to airfoil coord + real(ReKi), intent(in ) :: PitchAndTwist ! Pitch and twist of section + real(ReKi), intent(in ) :: Vstr_g(3) ! Structural velocity global coord + real(ReKi), intent(in ) :: Vind_g(3) ! Induced wind velocity global coord + real(ReKi), intent(in ) :: Vwnd_g(3) ! Disturbed inflow global coord + real(ReKi), intent(in ) :: KinVisc ! Viscosity + real(ReKi), intent(in ) :: Chord ! chord length + real(ReKi), intent( out) :: AxInd ! axial induction + real(ReKi), intent( out) :: TanInd ! Tangential induction + real(ReKi), intent( out) :: Vrel_norm ! Relative velocity norm + real(Reki), intent( out) :: phi ! Flow angle + real(Reki), intent( out) :: alpha ! angle of attack + real(ReKi), intent( out) :: Re ! Reynolds number + real(ReKi), intent( out) :: Urel_s(3) ! Relative wind of the airfoil (Vwnd - Vstr) section coord + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + + ! Local vars + real(ReKi) :: Vstr_s(3) ! Struct Velocity, section coord + real(ReKi) :: Vind_s(3) ! Induced Velocity, section coord + real(ReKi) :: Vwnd_s(3) ! Disturbed wind velocity, section coord + real(ReKi) :: Vtot_g(3) ! Vector of total relative velocity section coord + real(ReKi) :: Vtot_a(3) ! Vector of total relative velocity global coord + real(ReKi) :: Vtot_s(3) ! Vector of total relative velocity global coord + ErrStat = ErrID_None + ErrMsg = "" + !real(DbKi), dimension(3,3) :: M_sa !< Transformation matrix from airfoil to section coord + !real(DbKi), dimension(3,3) :: M_sg2 !< Transformation matrix from global to section coord + ! --- Transformation from airfoil to section (KEEP ME) + !M_sa(1,1:3) = (/ cos(PitchAndTwist*1._DbKi), sin(PitchAndTwist*1._DbKi), 0.0_DbKi /) + !M_sa(2,1:3) = (/ -sin(PitchAndTwist*1._DbKi), cos(PitchAndTwist*1._DbKi), 0.0_DbKi /) + !M_sa(3,1:3) = (/ 0.0_DbKi, 0.0_DbKi, 1.0_DbKi /) + !M_sg= matmul(M_sa, M_ag ) + + ! --- Airfoil coordinates: used to define alpha, and Vrel, also called "n-t" system + Vtot_g = Vwnd_g - Vstr_g + Vind_g + Vtot_a = matmul(M_ag, Vtot_g) + alpha = atan2( Vtot_a(1), Vtot_a(2) ) + Vrel_norm = sqrt(Vtot_a(1)**2 + Vtot_a(2)**2) ! NOTE: z component shoudn't be used + Re = Chord * Vrel_norm / KinVisc / 1.0E6 + + ! Section coordinates: used to define axial induction andflow angle + Vstr_s = matmul(M_sg, Vstr_g) + Vind_s = matmul(M_sg, Vind_g) + Vwnd_s = matmul(M_sg, Vwnd_g) + Urel_s = Vwnd_s - Vstr_s ! relative wind + Vtot_s = Vwnd_s - Vstr_s + Vind_s + AxInd = -Vind_s(1)/Urel_s(1) + TanInd = Vind_s(2)/Urel_s(2) + phi = atan2( Vtot_s(1), Vtot_s(2) ) ! flow angle + + if(.false.) print*,PitchAndTwist ! just to avoid unused var for now +end subroutine FVW_AeroOuts + +!> Generic function to compute alpha, Vrel and Re based on global data +subroutine AlphaVrel_Generic(M_ag, Vstr_g, Vind_g, Vwnd_g, KinVisc, Chord, Vrel_norm, alpha, Re) + real(R8Ki), intent(in ) :: M_ag(3,3) ! u%BladeMotion(k)%Orientation(1:3,1:3,j) global coord to airfoil coord + real(ReKi), intent(in ) :: Vstr_g(3) ! Structural velocity global coord + real(ReKi), intent(in ) :: Vind_g(3) ! Induced wind velocity global coord + real(ReKi), intent(in ) :: Vwnd_g(3) ! Disturbed inflow global coord + real(ReKi), intent(in ) :: KinVisc ! Viscosity + real(ReKi), intent(in ) :: Chord ! chord length + real(ReKi), intent( out) :: Vrel_norm ! Relative velocity norm + real(Reki), intent( out) :: alpha ! angle of attack + real(ReKi), intent( out) :: Re ! Reynolds number + ! Local vars + real(ReKi) :: Vtot_g(3) ! Vector of total relative velocity section coord + real(ReKi) :: Vtot_a(3) ! Vector of total relative velocity global coord + ! --- Airfoil coordinates: used to define alpha, and Vrel, also called "n-t" system + Vtot_g = Vwnd_g - Vstr_g + Vind_g + Vtot_a = matmul(M_ag, Vtot_g) + alpha = atan2( Vtot_a(1), Vtot_a(2) ) + Vrel_norm = sqrt(Vtot_a(1)**2 + Vtot_a(2)**2) ! NOTE: z component shoudn't be used + Re = Chord * Vrel_norm / KinVisc / 1.0E6 +end subroutine AlphaVrel_Generic + + +end module FVW_Subs diff --git a/modules/aerodyn/src/FVW_Tests.f90 b/modules/aerodyn/src/FVW_Tests.f90 new file mode 100644 index 0000000000..03dc1c19cf --- /dev/null +++ b/modules/aerodyn/src/FVW_Tests.f90 @@ -0,0 +1,754 @@ +module FVW_Tests + + use NWTC_Library + + use FVW_Types + use FVW_Subs + use FVW_VortexTools + use FVW_Wings + use FVW_IO + use FVW_BiotSavart + use FVW_VTK, only : FVW_VTK_Misc + + implicit none + + public :: FVW_RunTests + private + + interface test_equal; module procedure & + test_equal_i1, & + test_equal_i0 + end interface + interface test_almost_equal; module procedure & + test_almost_equal_0, & + test_almost_equal_1, & + test_almost_equal_2 + end interface +contains + ! -------------------------------------------------------------------------------- + ! --- Helper functions (should be part of NWTC library) + ! -------------------------------------------------------------------------------- + subroutine test_success(testname,info,bPrint_in) + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: info + logical, intent(in), optional :: bPrint_in + if(present(bPrint_in)) then + if(bPrint_in) then + write(*,'(A)')'[ OK ] '//trim(testname)//': '//trim(Info) + endif + else + write(*,'(A)')'[ OK ] '//trim(testname)//': '//trim(Info) + endif + end subroutine + + subroutine test_fail(testname,info,bPrint_in,bStop_in) + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: info + logical, intent(in), optional :: bPrint_in + logical, intent(in), optional :: bStop_in + if(present(bPrint_in)) then + if(bPrint_in) then + write(*,'(A)')'[FAIL] '//trim(testname)//': '//trim(Info) + endif + else + write(*,'(A)')'[FAIL] '//trim(testname)//': '//trim(Info) + endif + if(present(bStop_in)) then + if(bStop_in) then + STOP + endif + else + STOP + endif + end subroutine + + subroutine test_equal_i0(testname,Var,iTry,iRef) + ! Arguments + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: Var + integer, intent(in) :: iTry !< + integer, intent(in) :: iRef !< + ! Variables + character(len=255) :: InfoAbs + if(iRef/=iTry) then + write(InfoAbs,'(A,I0,A,I0)') trim(Var),iRef,'/',iTry + call test_fail(testname,InfoAbs) + STOP + else + write(InfoAbs,'(A,A,I0)') trim(Var),' ok ',iRef + call test_success(testname,InfoAbs) + endif + end subroutine + + subroutine test_equal_i1(testname,Var,VecTry,VecRef,bTest,bPrintOnly,bPassed) + ! Arguments + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: Var + integer, dimension(:), intent(in) :: VecTry !< + integer, dimension(:), intent(in) :: VecRef !< + logical, intent(in) :: bTest + logical, intent(in) :: bPrintOnly + logical, intent(out),optional :: bPassed + ! Variables + character(len=255) :: InfoAbs + integer :: i,cpt + ! + cpt=0 + do i=1,size(VecRef) + if(VecRef(i)/=VecTry(i)) then + cpt=cpt+1 + endif + enddo + if(cpt>0) then + write(InfoAbs,'(A,I0)') trim(Var)//' Elements different: ',cpt + if(present(bPassed)) then + bPassed=.false. + endif + else + write(InfoAbs,'(A)') trim(Var)//' reproduced to identity' + if(present(bPassed)) then + bPassed=.true. + endif + endif + if(bPrintOnly) then + print'(A)',trim(InfoAbs) + endif + if(bTest) then + if(cpt>0) then + call test_fail(testname,InfoAbs) + STOP + else + call test_success(testname,InfoAbs) + endif + endif + end subroutine + + subroutine test_almost_equal_0(testname,Var,Ref,Try,MINNORM,bStop,bPrint,bPassed) + ! Arguments + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: Var + real(ReKi), intent(in) :: Ref !< + real(ReKi), intent(in) :: Try !< + real(ReKi), intent(in) :: MINNORM + logical, intent(in) :: bStop + logical, intent(in) :: bPrint + logical, intent(out),optional :: bPassed + ! Variables + character(len=255) :: InfoAbs + real(ReKi) :: delta + integer :: cpt + ! + cpt=0 + delta=abs(Ref-Try) + if(delta>MINNORM) then + write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2,A,I0)') trim(Var)//' tol: ',MINNORM,', mean: ',delta,' - Failed:',cpt + call test_fail(testname,InfoAbs,bPrint,bStop) + else + write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2)') trim(Var)//' tol: ',MINNORM,', mean: ',delta + call test_success(testname,InfoAbs,bPrint) + endif + if(present(bPassed)) then + bPassed=delta>MINNORM + endif + end subroutine + subroutine test_almost_equal_1(testname,Var,VecRef,VecTry,MINNORM,bStop,bPrint,bPassed) + ! Arguments + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: Var + real(ReKi), dimension(:), intent(in) :: VecRef !< + real(ReKi), dimension(:), intent(in) :: VecTry !< + real(ReKi), intent(in) :: MINNORM + logical, intent(in) :: bStop + logical, intent(in) :: bPrint + logical, intent(out),optional :: bPassed + ! Variables + character(len=255) :: InfoAbs + integer :: i,cpt + real(ReKi) :: delta + real(ReKi) :: delta_cum + ! + cpt=0 + delta_cum=0.0_ReKi + do i=1,size(VecRef,1) + delta=abs(VecRef(i)-VecTry(i)) + delta_cum=delta_cum+delta + if(delta>MINNORM) then + cpt=cpt+1 + endif + enddo + delta_cum=delta_cum/size(VecRef) + + if(cpt>0) then + write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2,A,I0)') trim(Var)//' tol: ',MINNORM,', mean: ',delta_cum,' - Failed:',cpt + call test_fail(testname,InfoAbs,bPrint,bStop) + else + write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2)') trim(Var)//' tol: ',MINNORM,', mean: ',delta_cum + call test_success(testname,InfoAbs,bPrint) + endif + if(present(bPassed)) then + bPassed=(cpt==0) + endif + end subroutine + subroutine test_almost_equal_2(testname,Var,VecRef,VecTry,MINNORM,bStop,bPrint,bPassed) + ! Arguments + character(len=*), intent(in) :: testname + character(len=*), intent(in) :: Var + real(ReKi), dimension(:,:), intent(in) :: VecRef !< + real(ReKi), dimension(:,:), intent(in) :: VecTry !< + real(ReKi), intent(in) :: MINNORM + logical, intent(in) :: bStop + logical, intent(in) :: bPrint + logical, intent(out),optional :: bPassed + ! Variables + real(ReKi), dimension(:),allocatable :: VecRef2 !< + real(ReKi), dimension(:),allocatable :: VecTry2 !< + integer :: p, i,j,n1,n2,nCPs + ! + n1 = size(VecRef,1); n2 = size(VecRef,2); nCPs=n1*n2 + allocate ( VecRef2 (n1*n2) ) ; allocate ( VecTry2 (n1*n2) ) + p=0 + do j=1,n2; do i=1,n1 + p=p+1 + VecRef2(p)=VecRef(i,j) + VecTry2(p)=VecTry(i,j) + enddo; enddo; + call test_almost_equal(testname,Var,VecRef2,VecTry2,MINNORM,bStop,bPrint,bPassed) + end subroutine + + ! --------------------------------------------------------------------------------} + ! --- Specific FVW tests + ! --------------------------------------------------------------------------------{ + !> + subroutine Test_BiotSavart_Sgmt(testname, ErrStat, ErrMsg) + character(len=*), intent(in) :: testname + integer(IntKi) , intent(out) :: ErrStat !< Error status of the operation + character(ErrMsgLen), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(ReKi), dimension(3) :: P1,P2,P3,CP + real(ReKi), dimension(3) :: U1 + real(ReKi) :: SegGamma1 !< Circulation [m^2/s] + real(ReKi) :: RegParam1 !< + integer(IntKi) :: i1,i2 + integer(IntKi) :: RegFunction + integer(IntKi), parameter :: nSegTot = 2 + integer(IntKi), parameter :: nSegPTot = 3 + integer(IntKi), parameter :: nCPsTot = 1 + real(ReKi), dimension(3,nCPsTot) :: CPs !< Control points + real(ReKi), dimension(3,nSegPTot) :: SegPoints !< Segment points + integer(IntKi), dimension(2,nSegTot) :: SegConnct !< Connectivity, indices of segments points iSeg1, iSeg2 + real(ReKi), dimension(nSegTot) :: SegGamma !< Segment circulation + real(ReKi), dimension(nSegTot) :: RegParam !< Regularization parameter + real(ReKi), dimension(3,nCPsTot) :: Uind_out !< Induced velocity vector - Side effects!!! + real(ReKi), dimension(3,4) :: CPs_test !< + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! --- Test that the two functions return the same values + P1=(/0. ,0.,-1./) + P2=(/0. ,0., 1./) + CPs_test(:,1) = (/ 0.0, 0., 0.0 /) ! Middle + CPs_test(:,2) = P1 ! Extremity + CPs_test(:,3) = (/ 0.05, 0., -0.5 /) ! Close + CPs_test(:,4) = (/ 10., 0., 0.0 /) ! Far + do i2 = 1, size(CPs_test,2) + ! Segment param + CP=CPs_test(:,i2) + SegGamma1=1 + RegParam1=0.5 + ! One segment param + SegConnct(:,1)=(/1,2/) + SegPoints(:,1) = P1 + SegPoints(:,2) = P2 + SegGamma(:) = SegGamma1 + RegParam(:) = RegParam1 + CPs (:,1) = CP + do i1=1,5 + RegFunction = idRegVALID(i1) + ! Method 1 + Uind_out =0.0_ReKi + call ui_seg(1, 1, CPs, & + 1, 1, nSegTot, nSegPTot, SegPoints, SegConnct, SegGamma, & + RegFunction, RegParam, Uind_out) + ! Method 2 + call ui_seg_11(CP-P1, CP-P2, SegGamma1, RegFunction, RegParam1, U1) + ! Test + !print*,'Reg function', RegFunction, 'CP',CP + !print*,'Uind_out',Uind_out + !print*,'U1 ',U1 + call test_almost_equal(testname,'Uind method1/2', U1, Uind_out(:,1), 1e-4_ReKi, .true.,.true.) + !call test_almost_equal('Uind method1/2', U1, Uind_out(:,1), 1e-4, .false.,.true.) + enddo + enddo + + ! --- Test that the two segments or one segment returns the same value + P1=(/0. ,0.,-1./) + P2=(/0. ,0., 1./) + P3=(/0. ,0., 0./) + CPs_test(:,1) = (/ 0.0, 0., 0.0 /) ! Middle + CPs_test(:,2) = P1 ! Extremity + CPs_test(:,3) = (/ 0.05, 0., -0.5 /) ! Close + CPs_test(:,4) = (/ 100., 0., -0.5 /) ! Far + do i2 = 1,size(CPs_test,2) + ! Segment param + CP=CPs_test(:,i2) + SegGamma1=1 + RegParam1=0.5 + ! One segment param + SegConnct(:,1)=(/1,2/) + SegConnct(:,2)=(/2,3/) + SegPoints(:,1) = P1 + SegPoints(:,2) = P3 + SegPoints(:,3) = P2 + SegGamma(:) = SegGamma1 + RegParam(:) = RegParam1 + CPs (:,1) = CP + do i1=1,4 ! NOTE stopping at 4 since Offset is not linear + RegFunction = idRegVALID(i1) + ! Method 1 + Uind_out =0.0_ReKi + call ui_seg(1, 1, CPs, & + 1, 2, nSegTot, nSegPTot, SegPoints, SegConnct, SegGamma, & + RegFunction, RegParam, Uind_out) + ! Method 2 + call ui_seg_11(CP-P1, CP-P2, SegGamma1, RegFunction, RegParam1, U1) + !print*,'Reg function', RegFunction, 'CP',CP + !print*,'Uind_out',Uind_out + !print*,'U1 ',U1 + call test_almost_equal(testname,'Uind 1seg/2seg', U1, Uind_out(:,1), 1e-4_ReKi, .true.,.true.) + enddo + enddo + end subroutine + + !> + subroutine Test_BiotSavart_Part(testname, ErrStat, ErrMsg) + character(len=*), intent(in) :: testname + integer(IntKi) , intent(out) :: ErrStat !< Error status of the operation + character(ErrMsgLen), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(ReKi), dimension(3) :: P1,CP + real(ReKi), dimension(3) :: U1 + real(ReKi), dimension(3) :: PartAlpha1 !< Particle intensity alpha=om.dV [m^3/s] + real(ReKi) :: RegParam1 !< + integer(IntKi) :: i1,i2 + integer(IntKi) :: RegFunction + integer(IntKi), parameter :: nPart = 1 + integer(IntKi), parameter :: nCPs = 1 + real(ReKi), dimension(3,nCPs) :: CPs !< Control points + real(ReKi), dimension(3,nPart):: PartPoints !< Particle points + real(ReKi), dimension(3,nPart):: PartAlpha !< Particle circulation + real(ReKi), dimension(nPart) :: RegParam !< Regularization parameter + real(ReKi), dimension(3,nCPs) :: Uind_out !< Induced velocity vector - Side effects!!! + real(ReKi), dimension(3,4) :: CPs_test !< + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! --- Test that the two functions return the same values + P1=(/0.0, 0.0, -1.0 /) + CPs_test(:,1) = (/ 0.0, 0., 0.0 /) ! Middle + CPs_test(:,2) = P1 ! Extremity + CPs_test(:,3) = (/ 0.01, 0.01, -0.9 /) ! Close + CPs_test(:,4) = (/ 10., 0., 0.0 /) ! Far + do i1=1,3 + do i2 = 1, size(CPs_test,2) + ! Segment param + CP = CPs_test(:,i2) + PartAlpha1(1:2) = 0 + PartAlpha1(3 ) = 2 + RegParam1 = 0.5 + ! One segment param + PartPoints(:,1) = P1 + PartAlpha(:,1) = PartAlpha1 + RegParam(:) = RegParam1 + CPs (:,1) = CP + RegFunction = idRegPartVALID(i1) + ! Method 1 + Uind_out =0.0_ReKi + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunction, RegParam, Uind_out, nCPs, nPart) + ! Method 2 + call ui_part_nograd_11(CP-P1, PartAlpha1, RegFunction, RegParam1, U1) + ! Test + !print*,'Reg function', RegFunction, 'CP',CP + !print*,'Uind_out',Uind_out + !print*,'U1 ',U1 + call test_almost_equal(testname,'Uind part method1/2', U1, Uind_out(:,1), 1e-4_ReKi, .true.,.true.) + enddo + enddo + end subroutine Test_BiotSavart_Part + + !> This test compares calls using the tree algorithm and the direct N^2 evaluation + subroutine Test_BiotSavart_PartTree(testname, ErrStat, ErrMsg) + character(len=*), intent(in) :: testname + integer(IntKi) , intent(out) :: ErrStat !< Error status of the operation + character(ErrMsgLen), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(T_Tree) :: Tree + real(ReKi), dimension(3) :: U_ref + integer(IntKi) :: i1,i2,i3,k, iCP + integer(IntKi) :: RegFunction + integer(IntKi) :: nPart = 1 + integer(IntKi) :: nCPs = 1 + real(ReKi), dimension(:,:), allocatable :: CPs !< Control points + real(ReKi), dimension(:,:), allocatable :: PartPoints !< Particle points + real(ReKi), dimension(:,:), allocatable :: PartAlpha !< Particle circulation + real(ReKi), dimension(:) , allocatable :: RegParam !< Regularization parameter + real(ReKi), dimension(:,:), allocatable :: Uind1 !< Induced velocity vector - Side effects!!! + real(ReKi), dimension(:,:), allocatable :: Uind2 !< Induced velocity vector - Side effects!!! + real(ReKi) :: BranchFactor, BranchSmall + real(ReKi), dimension(3,5) :: CPs_test !< + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + BranchFactor = 2.0_ReKi !< Should be above1 + BranchSmall = 0.0_ReKi + RegFunction = 1 + + ! --- Test with 0 particle + nPart=0; nCPs= 1 + call alloc(nPart,nCPs) + CPs(:,1) = (/0.0,0.0,0.0/) + Uind1 =0.0_ReKi + Uind2 =0.0_ReKi + U_ref =0.0_ReKi + call grow_tree(Tree, PartPoints, PartAlpha, RegFunction, RegParam, 0) + !call print_tree(Tree) + call ui_tree(Tree, CPs, 0, 1, nCPs, BranchFactor, BranchSmall, Uind2, ErrStat, ErrMsg) + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunction, RegParam, Uind1, nCPs, nPart) + ! Test + call test_almost_equal(testname,'Uind tree 0 part', U_ref, Uind2(:,1), 1e-4_ReKi, .true.,.true.) + call cut_tree(Tree) + call dealloc() + + + ! --- Test with 1 particle + nPart=1; nCPs= 1 + call alloc(nPart,nCPs) + CPs(:,1) = (/0.0,0.0,0.0/) + PartPoints(1:3,1) = (/1.0,0.0,0.0/) + U_ref =0.0_ReKi + call grow_tree(Tree, PartPoints, PartAlpha, RegFunction, RegParam, 0) + !call print_tree(Tree) + call ui_tree(Tree, CPs, 0, 1, nCPs, BranchFactor, BranchSmall, Uind2, ErrStat, ErrMsg) + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunction, RegParam, Uind1, nCPs, nPart) + ! Test + call test_almost_equal(testname,'Uind tree 1 part', Uind1, Uind2, 1e-4_ReKi, .true.,.true.) + call cut_tree(Tree) + !call print_tree(Tree) + call dealloc() + + ! --- Test with 81 particles on different CPs, inside and outside the distribution of particles + nPart=3*3**3; nCPs= 1 + call alloc(nPart,nCPs) + k=0 + do i1 = -1,1,1 + do i2 = -1,1,1 + do i3 = -1,1,1 + ! NOTE: here we purposely duplicate a point, since since is a challenging case + k=k+1; PartPoints(1:3,k) = (/ i1, i2, i3 /) + k=k+1; PartPoints(1:3,k) = (/ i1, i2, i3 /) + k=k+1; PartPoints(1:3,k) = (/ i1*1.2, i2*1.3, i3*1.1 /) + enddo + enddo + enddo + CPs_test(:,1) = (/ 0.0, 0., 0.0 /) ! Middle + CPs_test(:,2) = (/ 1.0, 1.0, 1.0 /) ! Close to a cell center + CPs_test(:,3) = PartPoints(:,5) ! On a particle point + CPs_test(:,4) = (/ 2.0, 2.0, 2.0 /) ! Starts to be far from most points + CPs_test(:,5) = (/ 10., 10., 10.0 /) ! Far from all + + call grow_tree(Tree, PartPoints, PartAlpha, RegFunction, RegParam, 0) + !call print_tree(Tree) + do iCP=1,4 + CPs(:,1) = CPs_test(:,icp) + Uind2=0.0_ReKi; Uind1=0.0_ReKi + call ui_tree(Tree, CPs, 0, 1, nCPs, BranchFactor, BranchSmall, Uind2, ErrStat, ErrMsg) + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunction, RegParam, Uind1, nCPs, nPart) + !print*,'Uind',Uind1, Uind2 + ! Test + call test_almost_equal(testname,'Uind tree 81 part', Uind1, Uind2, 1e-2_ReKi, .true.,.true.) + enddo + call cut_tree(Tree) + ! --- Test that tree ui cannot be called after tree has been cut + call ui_tree(Tree, CPs, 0, 1, nCPs, BranchFactor, BranchSmall, Uind2, ErrStat, ErrMsg) + call test_equal(testname,'Err. stat tree cut',ErrStat,ErrID_Fatal) + call dealloc() + + contains + subroutine alloc(nPart, nCPs) + integer(IntKi) :: nPart, nCPs + allocate(PartPoints(3,nPart), PartAlpha(3,nPart), RegParam(nPart)) + allocate(CPs(3,nCPs), Uind1(3,nCPs), Uind2(3,nCPs)) + RegParam(:)=0.01 + PartAlpha(1,:) = 0.0 + PartAlpha(2,:) = 0.0 + PartAlpha(3,:) = 1.0 + Uind1 =0.0_ReKi + Uind2 =0.0_ReKi + end subroutine + subroutine dealloc() + deallocate(PartPoints, PartAlpha, RegParam) + deallocate(CPs, Uind1, Uind2) + end subroutine + end subroutine Test_BiotSavart_PartTree + + !> Compares the velocity field obtained from a segment and its convert to particle version + subroutine Test_SegmentsToPart(testname, ErrStat, ErrMsg) + character(len=*), intent(in) :: testname + integer(IntKi) , intent(out) :: ErrStat !< Error status of the operation + character(ErrMsgLen), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(ReKi), dimension(:,:), allocatable :: PartPoints !< Particle points + real(ReKi), dimension(:,:), allocatable :: PartAlpha !< Particle circulation + real(ReKi), dimension(:) , allocatable :: PartEpsilon !< Regularization parameter + integer(IntKi), parameter :: nSegTot = 2 + integer(IntKi), parameter :: nSegPTot = 3 + integer(IntKi), parameter :: nCPsTot = 10 + real(ReKi), dimension(3,nSegPTot) :: SegPoints !< Segment points + integer(IntKi), dimension(2,nSegTot) :: SegConnct !< Connectivity, indices of segments points iSeg1, iSeg2 + real(ReKi), dimension(nSegTot) :: SegGamma !< Segment circulation + real(ReKi), dimension(nSegTot) :: SegEpsilon !< Regularization parameter + real(ReKi), dimension(3,nCPsTot) :: CPs !< Control points + real(ReKi), dimension(3,nCPsTot) :: Uind1 !< Induced velocity vector - Side effects!!! + real(ReKi), dimension(3,nCPsTot) :: Uind2 !< Induced velocity vector - Side effects!!! + real(ReKi) :: RegParam1 !< + integer(IntKi) :: nPartPerSeg, nPart, iHeadP + integer(IntKi) :: RegFunctionPart, RegFunctionSeg + ErrStat = ErrID_None + ErrMsg = "" + RegParam1=1.0 + ! Creating two aligned segments + SegConnct(:,1)=(/1,2/) + SegConnct(:,2)=(/2,3/) + SegPoints(:,1) = (/0. ,0.,-1./) + SegPoints(:,2) = (/0. ,0., 0./) + SegPoints(:,3) = (/0. ,0., 1./) + SegGamma(:) =4 + SegEpsilon = RegParam1 + ! Points where velocity will be evaluated + CPs(:,1) = SegPoints(:,1) + CPs(:,2) = SegPoints(:,2) + CPs(:,3) = SegPoints(:,3) + CPs(:,4) = (/ 0.2, 0.2, 0.0/) + CPs(:,6) = (/ 0.5, 0.5, 0. /) + CPs(:,8) = (/ 1.0, 1.0, 0./) + CPs(:,9) = (/ 10.0, 10.0, 0./) + CPs(:,5) = (/ 0.2, 0.2, 0.5/) + CPs(:,7) = (/ 0.5, 0.5, 0.5/) + CPs(:,10) = (/ 1.0, 1.0, 1./) + + ! --- Test 1 - 10 particles, no regularization + RegFunctionSeg = idRegNone + RegFunctionPart = idRegNone + nPartPerSeg = 10 + + nPart = nPartPerSeg * nSegTot + call alloc(nPart) + iHeadP=1 + call SegmentsToPart(SegPoints, SegConnct, SegGamma, SegEpsilon, 1, nSegTot, nPartPerSeg, PartPoints, PartAlpha, PartEpsilon, iHeadP) + + Uind1 =0.0_ReKi; Uind2 =0.0_ReKi; + call ui_seg(1, nCPsTot, CPs, 1, nSegTot, nSegTot, nSegPTot, SegPoints, SegConnct, SegGamma, RegFunctionSeg, SegEpsilon, Uind1) + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, Uind2, nCPsTot, nPart) + call test_almost_equal(testname,'Uind 10 part/sgmt no reg', Uind1, Uind2, 1e-3_ReKi, .true.,.true.) + call dealloc() + + ! --- Test 1 - 2 particles, no regularization + RegFunctionSeg = idRegNone + RegFunctionPart = idRegNone + nPartPerSeg = 2 + + nPart = nPartPerSeg * nSegTot + call alloc(nPart) + iHeadP=1 + call SegmentsToPart(SegPoints, SegConnct, SegGamma, SegEpsilon, 1, nSegTot, nPartPerSeg, PartPoints, PartAlpha, PartEpsilon, iHeadP) + + Uind1 =0.0_ReKi; Uind2 =0.0_ReKi; + call ui_seg(1, nCPsTot, CPs, 1, nSegTot, nSegTot, nSegPTot, SegPoints, SegConnct, SegGamma, RegFunctionSeg, SegEpsilon, Uind1) + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, Uind2, nCPsTot, nPart) + call test_almost_equal(testname,'Uind 2 part/sgmt noreg', Uind1, Uind2, 3e-1_ReKi, .true.,.true.) + call dealloc() + + + ! --- Test 3 - 10 particles, regularization + ! NOTE: more work needed to match the regularization functions and parameters optimally + RegFunctionSeg = idRegLambOseen + RegFunctionPart = idRegExp + nPartPerSeg = 10 + + nPart = nPartPerSeg * nSegTot + call alloc(nPart) + iHeadP=1 + call SegmentsToPart(SegPoints, SegConnct, SegGamma, SegEpsilon, 1, nSegTot, nPartPerSeg, PartPoints, PartAlpha, PartEpsilon, iHeadP) + + Uind1 =0.0_ReKi; Uind2 =0.0_ReKi; + call ui_seg(1, nCPsTot, CPs, 1, nSegTot, nSegTot, nSegPTot, SegPoints, SegConnct, SegGamma, RegFunctionSeg, SegEpsilon, Uind1) + call ui_part_nograd(CPs,PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, Uind2, nCPsTot, nPart) + !print'(A,10F7.3)','Uind1',Uind1(1,:) + !print'(A,10F7.3)','Uind2',Uind2(1,:) + !print'(A,10F7.3)','Uind1',Uind1(2,:) + !print'(A,10F7.3)','Uind2',Uind2(2,:) + !print'(A,10F7.3)','Uind1',Uind1(3,:) + !print'(A,10F7.3)','Uind2',Uind2(3,:) + call test_almost_equal(testname,'Uind 10 part/sgmt w.reg', Uind1, Uind2, 5e-2_ReKi, .true.,.true.) + call dealloc() + + contains + subroutine alloc(n) + integer(IntKi) :: n + allocate(PartPoints(3,n), PartAlpha(3,n), PartEpsilon(n)) + PartAlpha(:,:) = -99999.99_ReKi + PartPoints(:,:) = -99999.99_ReKi + PartEpsilon(:) = -99999.99_ReKi + end subroutine + subroutine dealloc() + deallocate(PartPoints, PartAlpha, PartEpsilon) + end subroutine + end subroutine Test_SegmentsToPart + + !> + subroutine Test_LatticeToSegment(mvtk,iStat) + type(FVW_VTK_Misc),intent(inout) :: mvtk !< miscvars for VTK output + integer(IntKi), intent( out) :: iStat !< Status for test + ! Local + integer(IntKi),dimension(:,:), allocatable :: SegConnct !< Segment connectivity + real(ReKi), dimension(:,:), allocatable :: SegPoints !< Segment Points + real(ReKi), dimension(:) , allocatable :: SegGamma !< Segment Circulation + real(ReKi), dimension(:), allocatable :: SegEpsilon !< + ! + real(ReKi), dimension(:,:,:), allocatable :: LatticePoints1 !< Lattice Points + real(ReKi), dimension(:,:,:), allocatable :: LatticePoints2 !< Lattice Points + real(ReKi), dimension(:,:), allocatable :: LatticeGamma1 !< Lattice Circulation + real(ReKi), dimension(:,:), allocatable :: LatticeGamma2 !< Lattice Circulation + real(ReKi), dimension(:,:), allocatable :: CPs !< ControlPoints + real(ReKi), dimension(:,:), allocatable :: Uind !< Induced velocity + integer(IntKi) :: iHeadC + integer(IntKi) :: iHeadP + integer(IntKi) :: i,j + integer(IntKi) :: nP + integer(IntKi) :: nC + integer(IntKi) :: nP1, nP2 + integer(IntKi) :: nC1, nC2 + integer(IntKi) :: nDepth, nSpan + integer(IntKi) :: SmoothModel + logical :: bladeFrame !< Output in blade frame instead of global coordinate frame + iStat=0 + bladeFrame=.FALSE. + + ! --- Creating two lattice + allocate(LatticePoints1(3,2,2)) + allocate(LatticePoints2(3,3,4)) + allocate(LatticeGamma1(1,1)) ; + allocate(LatticeGamma2(2,3)) ; + LatticeGamma1=1 + ! Test shed vorticity + LatticeGamma2(:,1)=1 + LatticeGamma2(:,2)=2 + LatticeGamma2(:,3)=3 + ! Test trailed vorticity +! LatticeGamma2(1,:)=1 +! LatticeGamma2(2,:)=2 + CALL MeshMe(LatticePoints1,(/0.,0.,0./)) + CALL MeshMe(LatticePoints2,(/0.,0.,1./)) + + CALL WrVTK_Lattice('Points1.vtk',mvtk,LatticePoints1, LatticeGamma1, bladeframe=bladeframe) + CALL WrVTK_Lattice('Points2.vtk',mvtk,LatticePoints2, LatticeGamma2, bladeframe=bladeframe) + + ! --- Convert lattice 1 to segments + nSpan = size(LatticePoints1,2) + nDepth = size(LatticePoints1,3) + nP1 = nSpan*nDepth + nC1 = 2*(nSpan*nDepth)-nSpan-nDepth + allocate(SegConnct(1:2,1:nC1)); SegConnct=-1 + allocate(SegPoints(1:3,1:nP1)); SegPoints=-1 + allocate(SegGamma (1:nC1) ); SegGamma=-999 + allocate(SegEpsilon(1:nC1) ); SegEpsilon=0.0_ReKi + + iHeadP=1 + iHeadC=1 + CALL LatticeToSegments(LatticePoints1, LatticeGamma1, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .true., .true. ) + CALL printall() + CALL WrVTK_Segments('Points1_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) + + allocate(Uind(1:3,1) ); Uind=0.0_ReKi + allocate(CPs (1:3,1) ); + CPs(1:3,1)=(/1.5,1.5,0./) + SegEpsilon=100.0_ReKi + SmoothModel=0 ! No smooth + CALL ui_seg(1, 1, CPs, & + 1, nC1, nC1, nP1, SegPoints, SegConnct, SegGamma, & + SmoothModel, SegEpsilon, Uind) + !print*,'Uind',Uind + + ! --- Convert lattice 2 to segments + nSpan = size(LatticePoints2,2) + nDepth = size(LatticePoints2,3) + nP2 = nSpan*nDepth + nC2 = 2*(nSpan*nDepth)-nSpan-nDepth + deallocate(SegConnct) + deallocate(SegPoints) + deallocate(SegGamma) + allocate(SegConnct(1:2,1:nC2)); SegConnct=-1 + allocate(SegPoints(1:3,1:nP2)); SegPoints=-1 + allocate(SegGamma (1:nC2) ); SegGamma=-9999 + iHeadP=1 + iHeadC=1 + CALL LatticeToSegments(LatticePoints2, LatticeGamma2, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC , .true., .true.) + CALL printall() + CALL WrVTK_Segments('Points2_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) + + ! --- Concatenate both + nP = nP1 + nP2 + nC = nC1 + nC2 + iHeadP=1 + iHeadC=1 + deallocate(SegConnct) + deallocate(SegPoints) + deallocate(SegGamma) + allocate(SegConnct(1:2,1:nC)); SegConnct=-1 + allocate(SegPoints(1:3,1:nP)); SegPoints=-1 + allocate(SegGamma (1:nC) ); SegGamma=-9999 + CALL LatticeToSegments(LatticePoints1, LatticeGamma1, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .true. , .true.) + CALL LatticeToSegments(LatticePoints2, LatticeGamma2, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .true. , .true.) + CALL printall() + CALL WrVTK_Segments('PointsBoth_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) + + + contains + subroutine printall() + print*,'Points' + do i=1,size(SegPoints,2) + print*,'i',i,'Coords:', SegPoints(1:3,i) + enddo + print*,'Connectivity' + do i=1,size(SegConnct,2) + print*,'i',i,'Conn:', SegConnct(1:2,i),'Gam:', SegGamma(i) + enddo + print*,'-----------------------------' + endsubroutine + + subroutine MeshMe(M,offset) + real(ReKi), dimension(:,:,:), intent(inout) :: M + real(ReKi), dimension(3) , intent(in ):: offset + do j=1,size(M,3) + do i=1,size(M,2) + M(1,i,j)=i + offset(1) + M(2,i,j)=j + offset(2) + M(3,i,j)=0 + offset(3) + enddo + enddo + endsubroutine + endsubroutine Test_LatticeToSegment + + !> Main test function + subroutine FVW_RunTests(ErrStat,ErrMsg) + integer(IntKi) , intent(out) :: ErrStat !< Error status of the operation + character(ErrMsgLen), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(len=255) :: testname + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + testname='FVW' + call Test_BiotSavart_Sgmt(testname, ErrStat2, ErrMsg2) + call Test_BiotSavart_Part(testname, ErrStat2, ErrMsg2) + call Test_BiotSavart_PartTree(testname, ErrStat2, ErrMsg2) + call Test_SegmentsToPart(testname, ErrStat2, ErrMsg2) + end subroutine FVW_RunTests + +end module FVW_Tests diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 new file mode 100644 index 0000000000..f5d4452578 --- /dev/null +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -0,0 +1,8216 @@ +!STARTOFREGISTRYGENERATEDFILE 'FVW_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! FVW_Types +!................................................................................................................................. +! This file is part of FVW. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in FVW. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE FVW_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE AirfoilInfo_Types +USE UnsteadyAero_Types +USE NWTC_Library +IMPLICIT NONE +! ========= FVW_ParameterType ======= + TYPE, PUBLIC :: FVW_ParameterType + INTEGER(IntKi) :: nWings !< Number of Wings [-] + INTEGER(IntKi) :: nSpan !< TODO, should be defined per wing. Number of spanwise element [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [idx1= BladeNode, idx2=Blade number] [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Chord !< Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number] [-] + INTEGER(IntKi) :: nNWMax !< Maximum number of nw panels, per wing [-] + INTEGER(IntKi) :: nFWMax !< Maximum number of fw panels, per wing [-] + INTEGER(IntKi) :: nFWFree !< Number of fw panels that are free, per wing [-] + LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] + REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCirculationStart !< Time when the circulation is full [s] + INTEGER(IntKi) :: CirculationMethod !< Method to determine the circulation [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PrescribedCirculation !< Prescribed circulation on all lifting lines [m/s] + INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam !< Initial value of the regularization parameter [-] + REAL(ReKi) :: WingRegParam !< Regularization parameter of the wing [-] + INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] + INTEGER(IntKi) :: VelocityMethod !< Velocity calculation method [-] + REAL(ReKi) :: TreeBranchFactor !< Factor used to determine if a point is far enough [-] + INTEGER(IntKi) :: PartPerSegment !< Number of particles per segment, e.g. for tree method [-] + REAL(DbKi) :: DTaero !< Time interval for calls calculations [s] + REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] + REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk !< DT between vtk writes [s] + INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + END TYPE FVW_ParameterType +! ======================= +! ========= FVW_MiscVarType ======= + TYPE, PUBLIC :: FVW_MiscVarType + LOGICAL :: FirstCall !< True if this is the first call to update state (used in CalcOutput) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LE !< Leading edge points [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TE !< Trailing edge points [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_LL !< Position of the Lifting line panels [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: s_LL !< Spanwise coordinate of LL elements [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord_LL !< chord on LL nodes [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: s_CP_LL !< Spanwise coordinate of LL CP [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord_CP_LL !< chord on LL cp [m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CP_LL !< Coordinates of LL CP [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Tang !< Unit Tangential vector on LL CP [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Norm !< Unit Normal vector on LL CP [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Orth !< Unit Orthogonal vector on LL CP [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: dl !< Vector of elementary length along the LL [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Area !< Area of each LL panel [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: diag_LL !< Diagonal length of each LL panel [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Gamma_LL !< Circulation on the wing lifting line (COPY of Constraint State) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_LL !< Induced velocity on lifting line control points [m/s] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vtot_LL !< Total velocity on lifting line control points [m/s] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vstr_LL !< Structural velocity on LL CP [m/s] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vwnd_LL !< Wind on lifting line control points [m/s] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Vwnd_NW !< Wind on near wake panels [m/s] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Vwnd_FW !< Wind on far wake panels [m/s] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Vind_NW !< Induced velocity on near wake panels [m/s] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Vind_FW !< Induced velocity on far wake panels [m/s] + INTEGER(IntKi) :: nNW !< Number of active near wake panels [-] + INTEGER(IntKi) :: nFW !< Number of active far wake panels [-] + INTEGER(IntKi) :: iStep !< Current step number used for update state [-] + INTEGER(IntKi) :: VTKstep !< Current vtk output step number [-] + REAL(DbKi) :: VTKlastTime !< Time the last VTK file set was written out [s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: r_wind !< List of points where wind is requested for next time step [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PitchAndTwist !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] + LOGICAL :: ComputeWakeInduced !< Compute induced velocities on this timestep [-] + REAL(DbKi) :: OldWakeTime !< Time the wake induction velocities were last calculated [s] + REAL(ReKi) :: tSpent !< Time spent in expensive Biot-Savart computation [s] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: dxdt_NW !< State time derivatie, stored for subcylcing [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: dxdt_FW !< State time derivatie, stored for subcylcing [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: SegConnct !< Connectivity of segments [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SegPoints !< Points delimiting the segments [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SegGamma !< Segment circulations [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SegEpsilon !< Segment regularization parameter [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CPs !< Control points used for wake rollup computation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Uind !< Induced velocities obtained at control points [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_AxInd !< Axial induction [size: (NumBlNds,numBlades)] [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_TanInd !< Tangential induction [size: (NumBlNds,numBlades)] [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Vrel !< Relative velocity [size: (NumBlNds,numBlades)] [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_alpha !< Angle of attack [size: (NumBlNds,numBlades)] [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_phi !< angle between the plane of rotation and the direction of the local wind [size: (NumBlNds,numBlades)] [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Re !< Reynolds number [size: (NumBlNds,numBlades)] [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BN_URelWind_s !< Relative wind velocity in section coordinates [size: (3,NumBlNds,numBlades)] [m/s] + 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_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 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cx !< normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cy !< tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade [-] + TYPE(UA_MiscVarType) :: m_UA !< misc vars for UnsteadyAero [-] + TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] + TYPE(UA_ParameterType) :: p_UA !< parameters for UnsteadyAero [-] + LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vwnd_ND !< InflowOnBlade (at nodes) values modified by tower influence. ONLY for UA [m/s] + END TYPE FVW_MiscVarType +! ======================= +! ========= FVW_InputType ======= + TYPE, PUBLIC :: FVW_InputType + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: WingsMesh !< Input Mesh defining position and orientation of wings [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_wind !< Wind at requested points (r_wind) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< Orientation of hub coordinate system (for output only) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< Origin of hub (for output only) [-] + END TYPE FVW_InputType +! ======================= +! ========= FVW_OutputType ======= + TYPE, PUBLIC :: FVW_OutputType + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind !< TODO mesh - Induced velocity vector. [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cl_KJ !< Lift coefficient from circulation (Kutta-Joukowski) [-] + END TYPE FVW_OutputType +! ======================= +! ========= FVW_ContinuousStateType ======= + TYPE, PUBLIC :: FVW_ContinuousStateType + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Gamma_NW !< Circulation of the near wake panels [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Gamma_FW !< Circulation of the far wake panels [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_NW !< Position of the near wake panels [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_FW !< Position of the far wake panels [-] + END TYPE FVW_ContinuousStateType +! ======================= +! ========= FVW_DiscreteStateType ======= + TYPE, PUBLIC :: FVW_DiscreteStateType + REAL(ReKi) :: NULL !< Empty to satisfy framework [-] + TYPE(UA_DiscreteStateType) :: UA !< states for UnsteadyAero [-] + END TYPE FVW_DiscreteStateType +! ======================= +! ========= FVW_ConstraintStateType ======= + TYPE, PUBLIC :: FVW_ConstraintStateType + REAL(ReKi) :: residual + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Gamma_LL !< Circulation on the wing lifting line [-] + END TYPE FVW_ConstraintStateType +! ======================= +! ========= FVW_OtherStateType ======= + TYPE, PUBLIC :: FVW_OtherStateType + INTEGER(IntKi) :: NULL !< Number of active near wake panels [-] + TYPE(UA_OtherStateType) :: UA !< other states for UnsteadyAero [-] + LOGICAL , DIMENSION(:,:), ALLOCATABLE :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + END TYPE FVW_OtherStateType +! ======================= +! ========= FVW_InitInputType ======= + TYPE, PUBLIC :: FVW_InitInputType + CHARACTER(1024) :: FVWFileName !< Main FVW input file name [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: WingsMesh !< Input Mesh defining position and orientation of wings (nSpan+1) [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [idx1=BladeNode, idx2=Blade number] [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Chord !< Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number] [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RElm !< radius of center of each element [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: zLocal !< Distance to blade node, measured along the blade [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zTip !< Distance to blade tip, measured along the blade [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] + INTEGER(IntKi) :: NumBlades !< Number of blades [-] + INTEGER(IntKi) :: NumBladeNodes !< Number of nodes on each blade [-] + REAL(DbKi) :: DTaero !< Time interval for calls (from AD15) [s] + REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s !< speed of sound [m/s] + END TYPE FVW_InitInputType +! ======================= +! ========= FVW_InputFile ======= + TYPE, PUBLIC :: FVW_InputFile + INTEGER(IntKi) :: CirculationMethod !< Method to determine the circulation [-] + CHARACTER(1024) :: CirculationFile !< Prescribed circulation file [-] + INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] + LOGICAL :: FreeWake !< Disable roll up, wake convects with wind only (flag) [-] + REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCirculationStart !< Time when the circulation is full [s] + REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] + INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: nNWPanels !< Number of nw panels [-] + INTEGER(IntKi) :: nFWPanels !< Number of fw panels [-] + INTEGER(IntKi) :: nFWPanelsFree !< Number of fw panels that are free [-] + LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam !< Factor used in the regularization [-] + REAL(ReKi) :: WingRegParam !< Factor used in the regularization [-] + INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] + INTEGER(IntKi) :: VelocityMethod !< Velocity calculation method [-] + REAL(ReKi) :: TreeBranchFactor !< Factor used to determine if a point is far enough [-] + INTEGER(IntKi) :: PartPerSegment !< Number of particles per segment, e.g. for tree method [-] + INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] + INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + END TYPE FVW_InputFile +! ======================= +! ========= FVW_InitOutputType ======= + TYPE, PUBLIC :: FVW_InitOutputType + INTEGER(IntKi) :: Null !< Empty parameter to satisfy framework [-] + END TYPE FVW_InitOutputType +! ======================= +CONTAINS + SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_ParameterType), INTENT(IN) :: SrcParamData + TYPE(FVW_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%nWings = SrcParamData%nWings + DstParamData%nSpan = SrcParamData%nSpan +IF (ALLOCATED(SrcParamData%AFindx)) THEN + i1_l = LBOUND(SrcParamData%AFindx,1) + i1_u = UBOUND(SrcParamData%AFindx,1) + i2_l = LBOUND(SrcParamData%AFindx,2) + i2_u = UBOUND(SrcParamData%AFindx,2) + IF (.NOT. ALLOCATED(DstParamData%AFindx)) THEN + ALLOCATE(DstParamData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AFindx = SrcParamData%AFindx +ENDIF +IF (ALLOCATED(SrcParamData%Chord)) THEN + i1_l = LBOUND(SrcParamData%Chord,1) + i1_u = UBOUND(SrcParamData%Chord,1) + i2_l = LBOUND(SrcParamData%Chord,2) + i2_u = UBOUND(SrcParamData%Chord,2) + IF (.NOT. ALLOCATED(DstParamData%Chord)) THEN + ALLOCATE(DstParamData%Chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Chord = SrcParamData%Chord +ENDIF + DstParamData%nNWMax = SrcParamData%nNWMax + DstParamData%nFWMax = SrcParamData%nFWMax + DstParamData%nFWFree = SrcParamData%nFWFree + DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart + DstParamData%FullCirculationStart = SrcParamData%FullCirculationStart + DstParamData%CirculationMethod = SrcParamData%CirculationMethod +IF (ALLOCATED(SrcParamData%PrescribedCirculation)) THEN + i1_l = LBOUND(SrcParamData%PrescribedCirculation,1) + i1_u = UBOUND(SrcParamData%PrescribedCirculation,1) + IF (.NOT. ALLOCATED(DstParamData%PrescribedCirculation)) THEN + ALLOCATE(DstParamData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%PrescribedCirculation = SrcParamData%PrescribedCirculation +ENDIF + DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter + DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit + DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation + DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar + DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod + DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc + DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod + DstParamData%RegFunction = SrcParamData%RegFunction + DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod + DstParamData%WakeRegParam = SrcParamData%WakeRegParam + DstParamData%WingRegParam = SrcParamData%WingRegParam + DstParamData%ShearModel = SrcParamData%ShearModel + DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake + DstParamData%VelocityMethod = SrcParamData%VelocityMethod + DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor + DstParamData%PartPerSegment = SrcParamData%PartPerSegment + DstParamData%DTaero = SrcParamData%DTaero + DstParamData%DTfvw = SrcParamData%DTfvw + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTKBlades = SrcParamData%VTKBlades + DstParamData%DTvtk = SrcParamData%DTvtk + DstParamData%VTKCoord = SrcParamData%VTKCoord + DstParamData%RootName = SrcParamData%RootName + END SUBROUTINE FVW_CopyParam + + SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(FVW_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyParam' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ParamData%AFindx)) THEN + DEALLOCATE(ParamData%AFindx) +ENDIF +IF (ALLOCATED(ParamData%Chord)) THEN + DEALLOCATE(ParamData%Chord) +ENDIF +IF (ALLOCATED(ParamData%PrescribedCirculation)) THEN + DEALLOCATE(ParamData%PrescribedCirculation) +ENDIF + END SUBROUTINE FVW_DestroyParam + + SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! nWings + Int_BufSz = Int_BufSz + 1 ! nSpan + Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no + IF ( ALLOCATED(InData%AFindx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx + END IF + Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no + IF ( ALLOCATED(InData%Chord) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Chord upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord + END IF + Int_BufSz = Int_BufSz + 1 ! nNWMax + Int_BufSz = Int_BufSz + 1 ! nFWMax + Int_BufSz = Int_BufSz + 1 ! nFWFree + Int_BufSz = Int_BufSz + 1 ! FWShedVorticity + Int_BufSz = Int_BufSz + 1 ! IntMethod + Re_BufSz = Re_BufSz + 1 ! FreeWakeStart + Re_BufSz = Re_BufSz + 1 ! FullCirculationStart + Int_BufSz = Int_BufSz + 1 ! CirculationMethod + Int_BufSz = Int_BufSz + 1 ! PrescribedCirculation allocated yes/no + IF ( ALLOCATED(InData%PrescribedCirculation) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! PrescribedCirculation upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PrescribedCirculation) ! PrescribedCirculation + END IF + Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter + Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit + Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation + Int_BufSz = Int_BufSz + 1 ! CircSolvPolar + Int_BufSz = Int_BufSz + 1 ! DiffusionMethod + Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc + Int_BufSz = Int_BufSz + 1 ! RegDeterMethod + Int_BufSz = Int_BufSz + 1 ! RegFunction + Int_BufSz = Int_BufSz + 1 ! WakeRegMethod + Re_BufSz = Re_BufSz + 1 ! WakeRegParam + Re_BufSz = Re_BufSz + 1 ! WingRegParam + Int_BufSz = Int_BufSz + 1 ! ShearModel + Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake + Int_BufSz = Int_BufSz + 1 ! VelocityMethod + Re_BufSz = Re_BufSz + 1 ! TreeBranchFactor + Int_BufSz = Int_BufSz + 1 ! PartPerSegment + Db_BufSz = Db_BufSz + 1 ! DTaero + Db_BufSz = Db_BufSz + 1 ! DTfvw + Re_BufSz = Re_BufSz + 1 ! KinVisc + Int_BufSz = Int_BufSz + 1 ! WrVTK + Int_BufSz = Int_BufSz + 1 ! VTKBlades + Db_BufSz = Db_BufSz + 1 ! DTvtk + Int_BufSz = Int_BufSz + 1 ! VTKCoord + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%nWings + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nSpan + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Chord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Chord,2), UBOUND(InData%Chord,2) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nNWMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFWMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFWFree + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FreeWakeStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FullCirculationStart + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CirculationMethod + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%PrescribedCirculation) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PrescribedCirculation,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrescribedCirculation,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%PrescribedCirculation,1), UBOUND(InData%PrescribedCirculation,1) + ReKiBuf(Re_Xferred) = InData%PrescribedCirculation(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CircSolvPolar + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DiffusionMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RegDeterMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RegFunction + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeRegMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WakeRegParam + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WingRegParam + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ShearModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VelocityMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TreeBranchFactor + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PartPerSegment + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTaero + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTfvw + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKBlades + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTvtk + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKCoord + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END SUBROUTINE FVW_PackParam + + SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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%nWings = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nSpan = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFindx)) DEALLOCATE(OutData%AFindx) + ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Chord)) DEALLOCATE(OutData%Chord) + ALLOCATE(OutData%Chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Chord,2), UBOUND(OutData%Chord,2) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%nNWMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFWMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFWFree = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) + Int_Xferred = Int_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FreeWakeStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FullCirculationStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CirculationMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrescribedCirculation not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PrescribedCirculation)) DEALLOCATE(OutData%PrescribedCirculation) + ALLOCATE(OutData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%PrescribedCirculation,1), UBOUND(OutData%PrescribedCirculation,1) + OutData%PrescribedCirculation(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CircSolvPolar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DiffusionMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RegDeterMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RegFunction = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakeRegMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakeRegParam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WingRegParam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) + Int_Xferred = Int_Xferred + 1 + OutData%VelocityMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TreeBranchFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PartPerSegment = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DTaero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTfvw = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DTvtk = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VTKCoord = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END SUBROUTINE FVW_UnPackParam + + SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(FVW_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%FirstCall = SrcMiscData%FirstCall +IF (ALLOCATED(SrcMiscData%LE)) THEN + i1_l = LBOUND(SrcMiscData%LE,1) + i1_u = UBOUND(SrcMiscData%LE,1) + i2_l = LBOUND(SrcMiscData%LE,2) + i2_u = UBOUND(SrcMiscData%LE,2) + i3_l = LBOUND(SrcMiscData%LE,3) + i3_u = UBOUND(SrcMiscData%LE,3) + IF (.NOT. ALLOCATED(DstMiscData%LE)) THEN + ALLOCATE(DstMiscData%LE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%LE = SrcMiscData%LE +ENDIF +IF (ALLOCATED(SrcMiscData%TE)) THEN + i1_l = LBOUND(SrcMiscData%TE,1) + i1_u = UBOUND(SrcMiscData%TE,1) + i2_l = LBOUND(SrcMiscData%TE,2) + i2_u = UBOUND(SrcMiscData%TE,2) + i3_l = LBOUND(SrcMiscData%TE,3) + i3_u = UBOUND(SrcMiscData%TE,3) + IF (.NOT. ALLOCATED(DstMiscData%TE)) THEN + ALLOCATE(DstMiscData%TE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%TE = SrcMiscData%TE +ENDIF +IF (ALLOCATED(SrcMiscData%r_LL)) THEN + i1_l = LBOUND(SrcMiscData%r_LL,1) + i1_u = UBOUND(SrcMiscData%r_LL,1) + i2_l = LBOUND(SrcMiscData%r_LL,2) + i2_u = UBOUND(SrcMiscData%r_LL,2) + i3_l = LBOUND(SrcMiscData%r_LL,3) + i3_u = UBOUND(SrcMiscData%r_LL,3) + i4_l = LBOUND(SrcMiscData%r_LL,4) + i4_u = UBOUND(SrcMiscData%r_LL,4) + IF (.NOT. ALLOCATED(DstMiscData%r_LL)) THEN + ALLOCATE(DstMiscData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%r_LL = SrcMiscData%r_LL +ENDIF +IF (ALLOCATED(SrcMiscData%s_LL)) THEN + i1_l = LBOUND(SrcMiscData%s_LL,1) + i1_u = UBOUND(SrcMiscData%s_LL,1) + i2_l = LBOUND(SrcMiscData%s_LL,2) + i2_u = UBOUND(SrcMiscData%s_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%s_LL)) THEN + ALLOCATE(DstMiscData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%s_LL = SrcMiscData%s_LL +ENDIF +IF (ALLOCATED(SrcMiscData%chord_LL)) THEN + i1_l = LBOUND(SrcMiscData%chord_LL,1) + i1_u = UBOUND(SrcMiscData%chord_LL,1) + i2_l = LBOUND(SrcMiscData%chord_LL,2) + i2_u = UBOUND(SrcMiscData%chord_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%chord_LL)) THEN + ALLOCATE(DstMiscData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chord_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%chord_LL = SrcMiscData%chord_LL +ENDIF +IF (ALLOCATED(SrcMiscData%s_CP_LL)) THEN + i1_l = LBOUND(SrcMiscData%s_CP_LL,1) + i1_u = UBOUND(SrcMiscData%s_CP_LL,1) + i2_l = LBOUND(SrcMiscData%s_CP_LL,2) + i2_u = UBOUND(SrcMiscData%s_CP_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%s_CP_LL)) THEN + ALLOCATE(DstMiscData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%s_CP_LL = SrcMiscData%s_CP_LL +ENDIF +IF (ALLOCATED(SrcMiscData%chord_CP_LL)) THEN + i1_l = LBOUND(SrcMiscData%chord_CP_LL,1) + i1_u = UBOUND(SrcMiscData%chord_CP_LL,1) + i2_l = LBOUND(SrcMiscData%chord_CP_LL,2) + i2_u = UBOUND(SrcMiscData%chord_CP_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%chord_CP_LL)) THEN + ALLOCATE(DstMiscData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%chord_CP_LL = SrcMiscData%chord_CP_LL +ENDIF +IF (ALLOCATED(SrcMiscData%CP_LL)) THEN + i1_l = LBOUND(SrcMiscData%CP_LL,1) + i1_u = UBOUND(SrcMiscData%CP_LL,1) + i2_l = LBOUND(SrcMiscData%CP_LL,2) + i2_u = UBOUND(SrcMiscData%CP_LL,2) + i3_l = LBOUND(SrcMiscData%CP_LL,3) + i3_u = UBOUND(SrcMiscData%CP_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%CP_LL)) THEN + ALLOCATE(DstMiscData%CP_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CP_LL = SrcMiscData%CP_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Tang)) THEN + i1_l = LBOUND(SrcMiscData%Tang,1) + i1_u = UBOUND(SrcMiscData%Tang,1) + i2_l = LBOUND(SrcMiscData%Tang,2) + i2_u = UBOUND(SrcMiscData%Tang,2) + i3_l = LBOUND(SrcMiscData%Tang,3) + i3_u = UBOUND(SrcMiscData%Tang,3) + IF (.NOT. ALLOCATED(DstMiscData%Tang)) THEN + ALLOCATE(DstMiscData%Tang(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Tang.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Tang = SrcMiscData%Tang +ENDIF +IF (ALLOCATED(SrcMiscData%Norm)) THEN + i1_l = LBOUND(SrcMiscData%Norm,1) + i1_u = UBOUND(SrcMiscData%Norm,1) + i2_l = LBOUND(SrcMiscData%Norm,2) + i2_u = UBOUND(SrcMiscData%Norm,2) + i3_l = LBOUND(SrcMiscData%Norm,3) + i3_u = UBOUND(SrcMiscData%Norm,3) + IF (.NOT. ALLOCATED(DstMiscData%Norm)) THEN + ALLOCATE(DstMiscData%Norm(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Norm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Norm = SrcMiscData%Norm +ENDIF +IF (ALLOCATED(SrcMiscData%Orth)) THEN + i1_l = LBOUND(SrcMiscData%Orth,1) + i1_u = UBOUND(SrcMiscData%Orth,1) + i2_l = LBOUND(SrcMiscData%Orth,2) + i2_u = UBOUND(SrcMiscData%Orth,2) + i3_l = LBOUND(SrcMiscData%Orth,3) + i3_u = UBOUND(SrcMiscData%Orth,3) + IF (.NOT. ALLOCATED(DstMiscData%Orth)) THEN + ALLOCATE(DstMiscData%Orth(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Orth.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Orth = SrcMiscData%Orth +ENDIF +IF (ALLOCATED(SrcMiscData%dl)) THEN + i1_l = LBOUND(SrcMiscData%dl,1) + i1_u = UBOUND(SrcMiscData%dl,1) + i2_l = LBOUND(SrcMiscData%dl,2) + i2_u = UBOUND(SrcMiscData%dl,2) + i3_l = LBOUND(SrcMiscData%dl,3) + i3_u = UBOUND(SrcMiscData%dl,3) + IF (.NOT. ALLOCATED(DstMiscData%dl)) THEN + ALLOCATE(DstMiscData%dl(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dl.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%dl = SrcMiscData%dl +ENDIF +IF (ALLOCATED(SrcMiscData%Area)) THEN + i1_l = LBOUND(SrcMiscData%Area,1) + i1_u = UBOUND(SrcMiscData%Area,1) + i2_l = LBOUND(SrcMiscData%Area,2) + i2_u = UBOUND(SrcMiscData%Area,2) + IF (.NOT. ALLOCATED(DstMiscData%Area)) THEN + ALLOCATE(DstMiscData%Area(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Area.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Area = SrcMiscData%Area +ENDIF +IF (ALLOCATED(SrcMiscData%diag_LL)) THEN + i1_l = LBOUND(SrcMiscData%diag_LL,1) + i1_u = UBOUND(SrcMiscData%diag_LL,1) + i2_l = LBOUND(SrcMiscData%diag_LL,2) + i2_u = UBOUND(SrcMiscData%diag_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%diag_LL)) THEN + ALLOCATE(DstMiscData%diag_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%diag_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%diag_LL = SrcMiscData%diag_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Gamma_LL)) THEN + i1_l = LBOUND(SrcMiscData%Gamma_LL,1) + i1_u = UBOUND(SrcMiscData%Gamma_LL,1) + i2_l = LBOUND(SrcMiscData%Gamma_LL,2) + i2_u = UBOUND(SrcMiscData%Gamma_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%Gamma_LL)) THEN + ALLOCATE(DstMiscData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Gamma_LL = SrcMiscData%Gamma_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vind_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vind_LL,1) + i1_u = UBOUND(SrcMiscData%Vind_LL,1) + i2_l = LBOUND(SrcMiscData%Vind_LL,2) + i2_u = UBOUND(SrcMiscData%Vind_LL,2) + i3_l = LBOUND(SrcMiscData%Vind_LL,3) + i3_u = UBOUND(SrcMiscData%Vind_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vind_LL)) THEN + ALLOCATE(DstMiscData%Vind_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vind_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vind_LL = SrcMiscData%Vind_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vtot_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vtot_LL,1) + i1_u = UBOUND(SrcMiscData%Vtot_LL,1) + i2_l = LBOUND(SrcMiscData%Vtot_LL,2) + i2_u = UBOUND(SrcMiscData%Vtot_LL,2) + i3_l = LBOUND(SrcMiscData%Vtot_LL,3) + i3_u = UBOUND(SrcMiscData%Vtot_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vtot_LL)) THEN + ALLOCATE(DstMiscData%Vtot_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vtot_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vtot_LL = SrcMiscData%Vtot_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vstr_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vstr_LL,1) + i1_u = UBOUND(SrcMiscData%Vstr_LL,1) + i2_l = LBOUND(SrcMiscData%Vstr_LL,2) + i2_u = UBOUND(SrcMiscData%Vstr_LL,2) + i3_l = LBOUND(SrcMiscData%Vstr_LL,3) + i3_u = UBOUND(SrcMiscData%Vstr_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vstr_LL)) THEN + ALLOCATE(DstMiscData%Vstr_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vstr_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vstr_LL = SrcMiscData%Vstr_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vwnd_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_LL,1) + i1_u = UBOUND(SrcMiscData%Vwnd_LL,1) + i2_l = LBOUND(SrcMiscData%Vwnd_LL,2) + i2_u = UBOUND(SrcMiscData%Vwnd_LL,2) + i3_l = LBOUND(SrcMiscData%Vwnd_LL,3) + i3_u = UBOUND(SrcMiscData%Vwnd_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_LL)) THEN + ALLOCATE(DstMiscData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_LL = SrcMiscData%Vwnd_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vwnd_NW)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_NW,1) + i1_u = UBOUND(SrcMiscData%Vwnd_NW,1) + i2_l = LBOUND(SrcMiscData%Vwnd_NW,2) + i2_u = UBOUND(SrcMiscData%Vwnd_NW,2) + i3_l = LBOUND(SrcMiscData%Vwnd_NW,3) + i3_u = UBOUND(SrcMiscData%Vwnd_NW,3) + i4_l = LBOUND(SrcMiscData%Vwnd_NW,4) + i4_u = UBOUND(SrcMiscData%Vwnd_NW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_NW)) THEN + ALLOCATE(DstMiscData%Vwnd_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_NW = SrcMiscData%Vwnd_NW +ENDIF +IF (ALLOCATED(SrcMiscData%Vwnd_FW)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_FW,1) + i1_u = UBOUND(SrcMiscData%Vwnd_FW,1) + i2_l = LBOUND(SrcMiscData%Vwnd_FW,2) + i2_u = UBOUND(SrcMiscData%Vwnd_FW,2) + i3_l = LBOUND(SrcMiscData%Vwnd_FW,3) + i3_u = UBOUND(SrcMiscData%Vwnd_FW,3) + i4_l = LBOUND(SrcMiscData%Vwnd_FW,4) + i4_u = UBOUND(SrcMiscData%Vwnd_FW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_FW)) THEN + ALLOCATE(DstMiscData%Vwnd_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_FW = SrcMiscData%Vwnd_FW +ENDIF +IF (ALLOCATED(SrcMiscData%Vind_NW)) THEN + i1_l = LBOUND(SrcMiscData%Vind_NW,1) + i1_u = UBOUND(SrcMiscData%Vind_NW,1) + i2_l = LBOUND(SrcMiscData%Vind_NW,2) + i2_u = UBOUND(SrcMiscData%Vind_NW,2) + i3_l = LBOUND(SrcMiscData%Vind_NW,3) + i3_u = UBOUND(SrcMiscData%Vind_NW,3) + i4_l = LBOUND(SrcMiscData%Vind_NW,4) + i4_u = UBOUND(SrcMiscData%Vind_NW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vind_NW)) THEN + ALLOCATE(DstMiscData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vind_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vind_NW = SrcMiscData%Vind_NW +ENDIF +IF (ALLOCATED(SrcMiscData%Vind_FW)) THEN + i1_l = LBOUND(SrcMiscData%Vind_FW,1) + i1_u = UBOUND(SrcMiscData%Vind_FW,1) + i2_l = LBOUND(SrcMiscData%Vind_FW,2) + i2_u = UBOUND(SrcMiscData%Vind_FW,2) + i3_l = LBOUND(SrcMiscData%Vind_FW,3) + i3_u = UBOUND(SrcMiscData%Vind_FW,3) + i4_l = LBOUND(SrcMiscData%Vind_FW,4) + i4_u = UBOUND(SrcMiscData%Vind_FW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vind_FW)) THEN + ALLOCATE(DstMiscData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vind_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vind_FW = SrcMiscData%Vind_FW +ENDIF + DstMiscData%nNW = SrcMiscData%nNW + DstMiscData%nFW = SrcMiscData%nFW + DstMiscData%iStep = SrcMiscData%iStep + DstMiscData%VTKstep = SrcMiscData%VTKstep + DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime +IF (ALLOCATED(SrcMiscData%r_wind)) THEN + i1_l = LBOUND(SrcMiscData%r_wind,1) + i1_u = UBOUND(SrcMiscData%r_wind,1) + i2_l = LBOUND(SrcMiscData%r_wind,2) + i2_u = UBOUND(SrcMiscData%r_wind,2) + IF (.NOT. ALLOCATED(DstMiscData%r_wind)) THEN + ALLOCATE(DstMiscData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%r_wind = SrcMiscData%r_wind +ENDIF +IF (ALLOCATED(SrcMiscData%PitchAndTwist)) THEN + i1_l = LBOUND(SrcMiscData%PitchAndTwist,1) + i1_u = UBOUND(SrcMiscData%PitchAndTwist,1) + i2_l = LBOUND(SrcMiscData%PitchAndTwist,2) + i2_u = UBOUND(SrcMiscData%PitchAndTwist,2) + IF (.NOT. ALLOCATED(DstMiscData%PitchAndTwist)) THEN + ALLOCATE(DstMiscData%PitchAndTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%PitchAndTwist = SrcMiscData%PitchAndTwist +ENDIF + DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced + DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime + DstMiscData%tSpent = SrcMiscData%tSpent +IF (ALLOCATED(SrcMiscData%dxdt_NW)) THEN + i1_l = LBOUND(SrcMiscData%dxdt_NW,1) + i1_u = UBOUND(SrcMiscData%dxdt_NW,1) + i2_l = LBOUND(SrcMiscData%dxdt_NW,2) + i2_u = UBOUND(SrcMiscData%dxdt_NW,2) + i3_l = LBOUND(SrcMiscData%dxdt_NW,3) + i3_u = UBOUND(SrcMiscData%dxdt_NW,3) + i4_l = LBOUND(SrcMiscData%dxdt_NW,4) + i4_u = UBOUND(SrcMiscData%dxdt_NW,4) + IF (.NOT. ALLOCATED(DstMiscData%dxdt_NW)) THEN + ALLOCATE(DstMiscData%dxdt_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dxdt_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%dxdt_NW = SrcMiscData%dxdt_NW +ENDIF +IF (ALLOCATED(SrcMiscData%dxdt_FW)) THEN + i1_l = LBOUND(SrcMiscData%dxdt_FW,1) + i1_u = UBOUND(SrcMiscData%dxdt_FW,1) + i2_l = LBOUND(SrcMiscData%dxdt_FW,2) + i2_u = UBOUND(SrcMiscData%dxdt_FW,2) + i3_l = LBOUND(SrcMiscData%dxdt_FW,3) + i3_u = UBOUND(SrcMiscData%dxdt_FW,3) + i4_l = LBOUND(SrcMiscData%dxdt_FW,4) + i4_u = UBOUND(SrcMiscData%dxdt_FW,4) + IF (.NOT. ALLOCATED(DstMiscData%dxdt_FW)) THEN + ALLOCATE(DstMiscData%dxdt_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dxdt_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%dxdt_FW = SrcMiscData%dxdt_FW +ENDIF +IF (ALLOCATED(SrcMiscData%alpha_LL)) THEN + i1_l = LBOUND(SrcMiscData%alpha_LL,1) + i1_u = UBOUND(SrcMiscData%alpha_LL,1) + i2_l = LBOUND(SrcMiscData%alpha_LL,2) + i2_u = UBOUND(SrcMiscData%alpha_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%alpha_LL)) THEN + ALLOCATE(DstMiscData%alpha_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%alpha_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%alpha_LL = SrcMiscData%alpha_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vreln_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vreln_LL,1) + i1_u = UBOUND(SrcMiscData%Vreln_LL,1) + i2_l = LBOUND(SrcMiscData%Vreln_LL,2) + i2_u = UBOUND(SrcMiscData%Vreln_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%Vreln_LL)) THEN + ALLOCATE(DstMiscData%Vreln_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vreln_LL = SrcMiscData%Vreln_LL +ENDIF +IF (ALLOCATED(SrcMiscData%SegConnct)) THEN + i1_l = LBOUND(SrcMiscData%SegConnct,1) + i1_u = UBOUND(SrcMiscData%SegConnct,1) + i2_l = LBOUND(SrcMiscData%SegConnct,2) + i2_u = UBOUND(SrcMiscData%SegConnct,2) + IF (.NOT. ALLOCATED(DstMiscData%SegConnct)) THEN + ALLOCATE(DstMiscData%SegConnct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegConnct.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SegConnct = SrcMiscData%SegConnct +ENDIF +IF (ALLOCATED(SrcMiscData%SegPoints)) THEN + i1_l = LBOUND(SrcMiscData%SegPoints,1) + i1_u = UBOUND(SrcMiscData%SegPoints,1) + i2_l = LBOUND(SrcMiscData%SegPoints,2) + i2_u = UBOUND(SrcMiscData%SegPoints,2) + IF (.NOT. ALLOCATED(DstMiscData%SegPoints)) THEN + ALLOCATE(DstMiscData%SegPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegPoints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SegPoints = SrcMiscData%SegPoints +ENDIF +IF (ALLOCATED(SrcMiscData%SegGamma)) THEN + i1_l = LBOUND(SrcMiscData%SegGamma,1) + i1_u = UBOUND(SrcMiscData%SegGamma,1) + IF (.NOT. ALLOCATED(DstMiscData%SegGamma)) THEN + ALLOCATE(DstMiscData%SegGamma(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegGamma.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SegGamma = SrcMiscData%SegGamma +ENDIF +IF (ALLOCATED(SrcMiscData%SegEpsilon)) THEN + i1_l = LBOUND(SrcMiscData%SegEpsilon,1) + i1_u = UBOUND(SrcMiscData%SegEpsilon,1) + IF (.NOT. ALLOCATED(DstMiscData%SegEpsilon)) THEN + ALLOCATE(DstMiscData%SegEpsilon(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegEpsilon.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SegEpsilon = SrcMiscData%SegEpsilon +ENDIF +IF (ALLOCATED(SrcMiscData%CPs)) THEN + i1_l = LBOUND(SrcMiscData%CPs,1) + i1_u = UBOUND(SrcMiscData%CPs,1) + i2_l = LBOUND(SrcMiscData%CPs,2) + i2_u = UBOUND(SrcMiscData%CPs,2) + IF (.NOT. ALLOCATED(DstMiscData%CPs)) THEN + ALLOCATE(DstMiscData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CPs = SrcMiscData%CPs +ENDIF +IF (ALLOCATED(SrcMiscData%Uind)) THEN + i1_l = LBOUND(SrcMiscData%Uind,1) + i1_u = UBOUND(SrcMiscData%Uind,1) + i2_l = LBOUND(SrcMiscData%Uind,2) + i2_u = UBOUND(SrcMiscData%Uind,2) + IF (.NOT. ALLOCATED(DstMiscData%Uind)) THEN + ALLOCATE(DstMiscData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Uind = SrcMiscData%Uind +ENDIF +IF (ALLOCATED(SrcMiscData%BN_AxInd)) THEN + i1_l = LBOUND(SrcMiscData%BN_AxInd,1) + i1_u = UBOUND(SrcMiscData%BN_AxInd,1) + i2_l = LBOUND(SrcMiscData%BN_AxInd,2) + i2_u = UBOUND(SrcMiscData%BN_AxInd,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_AxInd)) THEN + ALLOCATE(DstMiscData%BN_AxInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_AxInd = SrcMiscData%BN_AxInd +ENDIF +IF (ALLOCATED(SrcMiscData%BN_TanInd)) THEN + i1_l = LBOUND(SrcMiscData%BN_TanInd,1) + i1_u = UBOUND(SrcMiscData%BN_TanInd,1) + i2_l = LBOUND(SrcMiscData%BN_TanInd,2) + i2_u = UBOUND(SrcMiscData%BN_TanInd,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_TanInd)) THEN + ALLOCATE(DstMiscData%BN_TanInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_TanInd = SrcMiscData%BN_TanInd +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Vrel)) THEN + i1_l = LBOUND(SrcMiscData%BN_Vrel,1) + i1_u = UBOUND(SrcMiscData%BN_Vrel,1) + i2_l = LBOUND(SrcMiscData%BN_Vrel,2) + i2_u = UBOUND(SrcMiscData%BN_Vrel,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Vrel)) THEN + ALLOCATE(DstMiscData%BN_Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Vrel = SrcMiscData%BN_Vrel +ENDIF +IF (ALLOCATED(SrcMiscData%BN_alpha)) THEN + i1_l = LBOUND(SrcMiscData%BN_alpha,1) + i1_u = UBOUND(SrcMiscData%BN_alpha,1) + i2_l = LBOUND(SrcMiscData%BN_alpha,2) + i2_u = UBOUND(SrcMiscData%BN_alpha,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_alpha)) THEN + ALLOCATE(DstMiscData%BN_alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_alpha.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_alpha = SrcMiscData%BN_alpha +ENDIF +IF (ALLOCATED(SrcMiscData%BN_phi)) THEN + i1_l = LBOUND(SrcMiscData%BN_phi,1) + i1_u = UBOUND(SrcMiscData%BN_phi,1) + i2_l = LBOUND(SrcMiscData%BN_phi,2) + i2_u = UBOUND(SrcMiscData%BN_phi,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_phi)) THEN + ALLOCATE(DstMiscData%BN_phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_phi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_phi = SrcMiscData%BN_phi +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Re)) THEN + i1_l = LBOUND(SrcMiscData%BN_Re,1) + i1_u = UBOUND(SrcMiscData%BN_Re,1) + i2_l = LBOUND(SrcMiscData%BN_Re,2) + i2_u = UBOUND(SrcMiscData%BN_Re,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Re)) THEN + ALLOCATE(DstMiscData%BN_Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Re.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Re = SrcMiscData%BN_Re +ENDIF +IF (ALLOCATED(SrcMiscData%BN_URelWind_s)) THEN + i1_l = LBOUND(SrcMiscData%BN_URelWind_s,1) + i1_u = UBOUND(SrcMiscData%BN_URelWind_s,1) + i2_l = LBOUND(SrcMiscData%BN_URelWind_s,2) + i2_u = UBOUND(SrcMiscData%BN_URelWind_s,2) + i3_l = LBOUND(SrcMiscData%BN_URelWind_s,3) + i3_u = UBOUND(SrcMiscData%BN_URelWind_s,3) + IF (.NOT. ALLOCATED(DstMiscData%BN_URelWind_s)) THEN + ALLOCATE(DstMiscData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_URelWind_s = SrcMiscData%BN_URelWind_s +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cl_Static)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cl_Static,1) + i1_u = UBOUND(SrcMiscData%BN_Cl_Static,1) + i2_l = LBOUND(SrcMiscData%BN_Cl_Static,2) + i2_u = UBOUND(SrcMiscData%BN_Cl_Static,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cl_Static)) THEN + ALLOCATE(DstMiscData%BN_Cl_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cl_Static = SrcMiscData%BN_Cl_Static +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cd_Static)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cd_Static,1) + i1_u = UBOUND(SrcMiscData%BN_Cd_Static,1) + i2_l = LBOUND(SrcMiscData%BN_Cd_Static,2) + i2_u = UBOUND(SrcMiscData%BN_Cd_Static,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cd_Static)) THEN + ALLOCATE(DstMiscData%BN_Cd_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cd_Static = SrcMiscData%BN_Cd_Static +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cm_Static)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cm_Static,1) + i1_u = UBOUND(SrcMiscData%BN_Cm_Static,1) + i2_l = LBOUND(SrcMiscData%BN_Cm_Static,2) + i2_u = UBOUND(SrcMiscData%BN_Cm_Static,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cm_Static)) THEN + ALLOCATE(DstMiscData%BN_Cm_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cm_Static = SrcMiscData%BN_Cm_Static +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cl)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cl,1) + i1_u = UBOUND(SrcMiscData%BN_Cl,1) + i2_l = LBOUND(SrcMiscData%BN_Cl,2) + i2_u = UBOUND(SrcMiscData%BN_Cl,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cl)) THEN + ALLOCATE(DstMiscData%BN_Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cl.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cl = SrcMiscData%BN_Cl +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cd)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cd,1) + i1_u = UBOUND(SrcMiscData%BN_Cd,1) + i2_l = LBOUND(SrcMiscData%BN_Cd,2) + i2_u = UBOUND(SrcMiscData%BN_Cd,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cd)) THEN + ALLOCATE(DstMiscData%BN_Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cd = SrcMiscData%BN_Cd +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cm)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cm,1) + i1_u = UBOUND(SrcMiscData%BN_Cm,1) + i2_l = LBOUND(SrcMiscData%BN_Cm,2) + i2_u = UBOUND(SrcMiscData%BN_Cm,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cm)) THEN + ALLOCATE(DstMiscData%BN_Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cm = SrcMiscData%BN_Cm +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cx)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cx,1) + i1_u = UBOUND(SrcMiscData%BN_Cx,1) + i2_l = LBOUND(SrcMiscData%BN_Cx,2) + i2_u = UBOUND(SrcMiscData%BN_Cx,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cx)) THEN + ALLOCATE(DstMiscData%BN_Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cx = SrcMiscData%BN_Cx +ENDIF +IF (ALLOCATED(SrcMiscData%BN_Cy)) THEN + i1_l = LBOUND(SrcMiscData%BN_Cy,1) + i1_u = UBOUND(SrcMiscData%BN_Cy,1) + i2_l = LBOUND(SrcMiscData%BN_Cy,2) + i2_u = UBOUND(SrcMiscData%BN_Cy,2) + IF (.NOT. ALLOCATED(DstMiscData%BN_Cy)) THEN + ALLOCATE(DstMiscData%BN_Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BN_Cy.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BN_Cy = SrcMiscData%BN_Cy +ENDIF + CALL UA_CopyMisc( SrcMiscData%m_UA, DstMiscData%m_UA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL UA_CopyOutput( SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL UA_CopyParam( SrcMiscData%p_UA, DstMiscData%p_UA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstMiscData%UA_Flag = SrcMiscData%UA_Flag +IF (ALLOCATED(SrcMiscData%Vwnd_ND)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_ND,1) + i1_u = UBOUND(SrcMiscData%Vwnd_ND,1) + i2_l = LBOUND(SrcMiscData%Vwnd_ND,2) + i2_u = UBOUND(SrcMiscData%Vwnd_ND,2) + i3_l = LBOUND(SrcMiscData%Vwnd_ND,3) + i3_u = UBOUND(SrcMiscData%Vwnd_ND,3) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_ND)) THEN + ALLOCATE(DstMiscData%Vwnd_ND(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vwnd_ND.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_ND = SrcMiscData%Vwnd_ND +ENDIF + END SUBROUTINE FVW_CopyMisc + + SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(FVW_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscData%LE)) THEN + DEALLOCATE(MiscData%LE) +ENDIF +IF (ALLOCATED(MiscData%TE)) THEN + DEALLOCATE(MiscData%TE) +ENDIF +IF (ALLOCATED(MiscData%r_LL)) THEN + DEALLOCATE(MiscData%r_LL) +ENDIF +IF (ALLOCATED(MiscData%s_LL)) THEN + DEALLOCATE(MiscData%s_LL) +ENDIF +IF (ALLOCATED(MiscData%chord_LL)) THEN + DEALLOCATE(MiscData%chord_LL) +ENDIF +IF (ALLOCATED(MiscData%s_CP_LL)) THEN + DEALLOCATE(MiscData%s_CP_LL) +ENDIF +IF (ALLOCATED(MiscData%chord_CP_LL)) THEN + DEALLOCATE(MiscData%chord_CP_LL) +ENDIF +IF (ALLOCATED(MiscData%CP_LL)) THEN + DEALLOCATE(MiscData%CP_LL) +ENDIF +IF (ALLOCATED(MiscData%Tang)) THEN + DEALLOCATE(MiscData%Tang) +ENDIF +IF (ALLOCATED(MiscData%Norm)) THEN + DEALLOCATE(MiscData%Norm) +ENDIF +IF (ALLOCATED(MiscData%Orth)) THEN + DEALLOCATE(MiscData%Orth) +ENDIF +IF (ALLOCATED(MiscData%dl)) THEN + DEALLOCATE(MiscData%dl) +ENDIF +IF (ALLOCATED(MiscData%Area)) THEN + DEALLOCATE(MiscData%Area) +ENDIF +IF (ALLOCATED(MiscData%diag_LL)) THEN + DEALLOCATE(MiscData%diag_LL) +ENDIF +IF (ALLOCATED(MiscData%Gamma_LL)) THEN + DEALLOCATE(MiscData%Gamma_LL) +ENDIF +IF (ALLOCATED(MiscData%Vind_LL)) THEN + DEALLOCATE(MiscData%Vind_LL) +ENDIF +IF (ALLOCATED(MiscData%Vtot_LL)) THEN + DEALLOCATE(MiscData%Vtot_LL) +ENDIF +IF (ALLOCATED(MiscData%Vstr_LL)) THEN + DEALLOCATE(MiscData%Vstr_LL) +ENDIF +IF (ALLOCATED(MiscData%Vwnd_LL)) THEN + DEALLOCATE(MiscData%Vwnd_LL) +ENDIF +IF (ALLOCATED(MiscData%Vwnd_NW)) THEN + DEALLOCATE(MiscData%Vwnd_NW) +ENDIF +IF (ALLOCATED(MiscData%Vwnd_FW)) THEN + DEALLOCATE(MiscData%Vwnd_FW) +ENDIF +IF (ALLOCATED(MiscData%Vind_NW)) THEN + DEALLOCATE(MiscData%Vind_NW) +ENDIF +IF (ALLOCATED(MiscData%Vind_FW)) THEN + DEALLOCATE(MiscData%Vind_FW) +ENDIF +IF (ALLOCATED(MiscData%r_wind)) THEN + DEALLOCATE(MiscData%r_wind) +ENDIF +IF (ALLOCATED(MiscData%PitchAndTwist)) THEN + DEALLOCATE(MiscData%PitchAndTwist) +ENDIF +IF (ALLOCATED(MiscData%dxdt_NW)) THEN + DEALLOCATE(MiscData%dxdt_NW) +ENDIF +IF (ALLOCATED(MiscData%dxdt_FW)) THEN + DEALLOCATE(MiscData%dxdt_FW) +ENDIF +IF (ALLOCATED(MiscData%alpha_LL)) THEN + DEALLOCATE(MiscData%alpha_LL) +ENDIF +IF (ALLOCATED(MiscData%Vreln_LL)) THEN + DEALLOCATE(MiscData%Vreln_LL) +ENDIF +IF (ALLOCATED(MiscData%SegConnct)) THEN + DEALLOCATE(MiscData%SegConnct) +ENDIF +IF (ALLOCATED(MiscData%SegPoints)) THEN + DEALLOCATE(MiscData%SegPoints) +ENDIF +IF (ALLOCATED(MiscData%SegGamma)) THEN + DEALLOCATE(MiscData%SegGamma) +ENDIF +IF (ALLOCATED(MiscData%SegEpsilon)) THEN + DEALLOCATE(MiscData%SegEpsilon) +ENDIF +IF (ALLOCATED(MiscData%CPs)) THEN + DEALLOCATE(MiscData%CPs) +ENDIF +IF (ALLOCATED(MiscData%Uind)) THEN + DEALLOCATE(MiscData%Uind) +ENDIF +IF (ALLOCATED(MiscData%BN_AxInd)) THEN + DEALLOCATE(MiscData%BN_AxInd) +ENDIF +IF (ALLOCATED(MiscData%BN_TanInd)) THEN + DEALLOCATE(MiscData%BN_TanInd) +ENDIF +IF (ALLOCATED(MiscData%BN_Vrel)) THEN + DEALLOCATE(MiscData%BN_Vrel) +ENDIF +IF (ALLOCATED(MiscData%BN_alpha)) THEN + DEALLOCATE(MiscData%BN_alpha) +ENDIF +IF (ALLOCATED(MiscData%BN_phi)) THEN + DEALLOCATE(MiscData%BN_phi) +ENDIF +IF (ALLOCATED(MiscData%BN_Re)) THEN + DEALLOCATE(MiscData%BN_Re) +ENDIF +IF (ALLOCATED(MiscData%BN_URelWind_s)) THEN + DEALLOCATE(MiscData%BN_URelWind_s) +ENDIF +IF (ALLOCATED(MiscData%BN_Cl_Static)) THEN + DEALLOCATE(MiscData%BN_Cl_Static) +ENDIF +IF (ALLOCATED(MiscData%BN_Cd_Static)) THEN + DEALLOCATE(MiscData%BN_Cd_Static) +ENDIF +IF (ALLOCATED(MiscData%BN_Cm_Static)) THEN + DEALLOCATE(MiscData%BN_Cm_Static) +ENDIF +IF (ALLOCATED(MiscData%BN_Cl)) THEN + DEALLOCATE(MiscData%BN_Cl) +ENDIF +IF (ALLOCATED(MiscData%BN_Cd)) THEN + DEALLOCATE(MiscData%BN_Cd) +ENDIF +IF (ALLOCATED(MiscData%BN_Cm)) THEN + DEALLOCATE(MiscData%BN_Cm) +ENDIF +IF (ALLOCATED(MiscData%BN_Cx)) THEN + DEALLOCATE(MiscData%BN_Cx) +ENDIF +IF (ALLOCATED(MiscData%BN_Cy)) THEN + DEALLOCATE(MiscData%BN_Cy) +ENDIF + CALL UA_DestroyMisc( MiscData%m_UA, ErrStat, ErrMsg ) + CALL UA_DestroyOutput( MiscData%y_UA, ErrStat, ErrMsg ) + CALL UA_DestroyParam( MiscData%p_UA, ErrStat, ErrMsg ) +IF (ALLOCATED(MiscData%Vwnd_ND)) THEN + DEALLOCATE(MiscData%Vwnd_ND) +ENDIF + END SUBROUTINE FVW_DestroyMisc + + SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! FirstCall + Int_BufSz = Int_BufSz + 1 ! LE allocated yes/no + IF ( ALLOCATED(InData%LE) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! LE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%LE) ! LE + END IF + Int_BufSz = Int_BufSz + 1 ! TE allocated yes/no + IF ( ALLOCATED(InData%TE) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! TE upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TE) ! TE + END IF + Int_BufSz = Int_BufSz + 1 ! r_LL allocated yes/no + IF ( ALLOCATED(InData%r_LL) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! r_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_LL) ! r_LL + END IF + Int_BufSz = Int_BufSz + 1 ! s_LL allocated yes/no + IF ( ALLOCATED(InData%s_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! s_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%s_LL) ! s_LL + END IF + Int_BufSz = Int_BufSz + 1 ! chord_LL allocated yes/no + IF ( ALLOCATED(InData%chord_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! chord_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%chord_LL) ! chord_LL + END IF + Int_BufSz = Int_BufSz + 1 ! s_CP_LL allocated yes/no + IF ( ALLOCATED(InData%s_CP_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! s_CP_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%s_CP_LL) ! s_CP_LL + END IF + Int_BufSz = Int_BufSz + 1 ! chord_CP_LL allocated yes/no + IF ( ALLOCATED(InData%chord_CP_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! chord_CP_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%chord_CP_LL) ! chord_CP_LL + END IF + Int_BufSz = Int_BufSz + 1 ! CP_LL allocated yes/no + IF ( ALLOCATED(InData%CP_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! CP_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CP_LL) ! CP_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Tang allocated yes/no + IF ( ALLOCATED(InData%Tang) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Tang upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Tang) ! Tang + END IF + Int_BufSz = Int_BufSz + 1 ! Norm allocated yes/no + IF ( ALLOCATED(InData%Norm) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Norm upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Norm) ! Norm + END IF + Int_BufSz = Int_BufSz + 1 ! Orth allocated yes/no + IF ( ALLOCATED(InData%Orth) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Orth upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Orth) ! Orth + END IF + Int_BufSz = Int_BufSz + 1 ! dl allocated yes/no + IF ( ALLOCATED(InData%dl) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! dl upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%dl) ! dl + END IF + Int_BufSz = Int_BufSz + 1 ! Area allocated yes/no + IF ( ALLOCATED(InData%Area) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Area upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Area) ! Area + END IF + Int_BufSz = Int_BufSz + 1 ! diag_LL allocated yes/no + IF ( ALLOCATED(InData%diag_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! diag_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%diag_LL) ! diag_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Gamma_LL allocated yes/no + IF ( ALLOCATED(InData%Gamma_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Gamma_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Vind_LL allocated yes/no + IF ( ALLOCATED(InData%Vind_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vind_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind_LL) ! Vind_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Vtot_LL allocated yes/no + IF ( ALLOCATED(InData%Vtot_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vtot_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vtot_LL) ! Vtot_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Vstr_LL allocated yes/no + IF ( ALLOCATED(InData%Vstr_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vstr_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vstr_LL) ! Vstr_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Vwnd_LL allocated yes/no + IF ( ALLOCATED(InData%Vwnd_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vwnd_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LL) ! Vwnd_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Vwnd_NW allocated yes/no + IF ( ALLOCATED(InData%Vwnd_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vwnd_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_NW) ! Vwnd_NW + END IF + Int_BufSz = Int_BufSz + 1 ! Vwnd_FW allocated yes/no + IF ( ALLOCATED(InData%Vwnd_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vwnd_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_FW) ! Vwnd_FW + END IF + Int_BufSz = Int_BufSz + 1 ! Vind_NW allocated yes/no + IF ( ALLOCATED(InData%Vind_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vind_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind_NW) ! Vind_NW + END IF + Int_BufSz = Int_BufSz + 1 ! Vind_FW allocated yes/no + IF ( ALLOCATED(InData%Vind_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vind_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind_FW) ! Vind_FW + END IF + Int_BufSz = Int_BufSz + 1 ! nNW + Int_BufSz = Int_BufSz + 1 ! nFW + Int_BufSz = Int_BufSz + 1 ! iStep + Int_BufSz = Int_BufSz + 1 ! VTKstep + Db_BufSz = Db_BufSz + 1 ! VTKlastTime + Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no + IF ( ALLOCATED(InData%r_wind) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! r_wind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_wind) ! r_wind + END IF + Int_BufSz = Int_BufSz + 1 ! PitchAndTwist allocated yes/no + IF ( ALLOCATED(InData%PitchAndTwist) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PitchAndTwist upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PitchAndTwist) ! PitchAndTwist + END IF + Int_BufSz = Int_BufSz + 1 ! ComputeWakeInduced + Db_BufSz = Db_BufSz + 1 ! OldWakeTime + Re_BufSz = Re_BufSz + 1 ! tSpent + Int_BufSz = Int_BufSz + 1 ! dxdt_NW allocated yes/no + IF ( ALLOCATED(InData%dxdt_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! dxdt_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%dxdt_NW) ! dxdt_NW + END IF + Int_BufSz = Int_BufSz + 1 ! dxdt_FW allocated yes/no + IF ( ALLOCATED(InData%dxdt_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! dxdt_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%dxdt_FW) ! dxdt_FW + END IF + Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no + IF ( ALLOCATED(InData%alpha_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! alpha_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%alpha_LL) ! alpha_LL + END IF + Int_BufSz = Int_BufSz + 1 ! Vreln_LL allocated yes/no + IF ( ALLOCATED(InData%Vreln_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Vreln_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL + END IF + Int_BufSz = Int_BufSz + 1 ! SegConnct allocated yes/no + IF ( ALLOCATED(InData%SegConnct) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! SegConnct upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%SegConnct) ! SegConnct + END IF + Int_BufSz = Int_BufSz + 1 ! SegPoints allocated yes/no + IF ( ALLOCATED(InData%SegPoints) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! SegPoints upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SegPoints) ! SegPoints + END IF + Int_BufSz = Int_BufSz + 1 ! SegGamma allocated yes/no + IF ( ALLOCATED(InData%SegGamma) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SegGamma upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SegGamma) ! SegGamma + END IF + Int_BufSz = Int_BufSz + 1 ! SegEpsilon allocated yes/no + IF ( ALLOCATED(InData%SegEpsilon) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SegEpsilon upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SegEpsilon) ! SegEpsilon + END IF + Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no + IF ( ALLOCATED(InData%CPs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CPs) ! CPs + END IF + Int_BufSz = Int_BufSz + 1 ! Uind allocated yes/no + IF ( ALLOCATED(InData%Uind) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Uind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Uind) ! Uind + END IF + Int_BufSz = Int_BufSz + 1 ! BN_AxInd allocated yes/no + IF ( ALLOCATED(InData%BN_AxInd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_AxInd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_AxInd) ! BN_AxInd + END IF + Int_BufSz = Int_BufSz + 1 ! BN_TanInd allocated yes/no + IF ( ALLOCATED(InData%BN_TanInd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_TanInd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_TanInd) ! BN_TanInd + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Vrel allocated yes/no + IF ( ALLOCATED(InData%BN_Vrel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Vrel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Vrel) ! BN_Vrel + END IF + Int_BufSz = Int_BufSz + 1 ! BN_alpha allocated yes/no + IF ( ALLOCATED(InData%BN_alpha) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_alpha upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_alpha) ! BN_alpha + END IF + Int_BufSz = Int_BufSz + 1 ! BN_phi allocated yes/no + IF ( ALLOCATED(InData%BN_phi) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_phi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_phi) ! BN_phi + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Re allocated yes/no + IF ( ALLOCATED(InData%BN_Re) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Re upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Re) ! BN_Re + END IF + Int_BufSz = Int_BufSz + 1 ! BN_URelWind_s allocated yes/no + IF ( ALLOCATED(InData%BN_URelWind_s) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BN_URelWind_s upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_URelWind_s) ! BN_URelWind_s + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cl_Static allocated yes/no + IF ( ALLOCATED(InData%BN_Cl_Static) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cl_Static upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl_Static) ! BN_Cl_Static + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cd_Static allocated yes/no + IF ( ALLOCATED(InData%BN_Cd_Static) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cd_Static upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd_Static) ! BN_Cd_Static + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cm_Static allocated yes/no + IF ( ALLOCATED(InData%BN_Cm_Static) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! 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_Cl allocated yes/no + IF ( ALLOCATED(InData%BN_Cl) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cl upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl) ! BN_Cl + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cd allocated yes/no + IF ( ALLOCATED(InData%BN_Cd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd) ! BN_Cd + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cm allocated yes/no + IF ( ALLOCATED(InData%BN_Cm) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cm upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm) ! BN_Cm + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cx allocated yes/no + IF ( ALLOCATED(InData%BN_Cx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cx) ! BN_Cx + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cy allocated yes/no + IF ( ALLOCATED(InData%BN_Cy) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cy upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype + CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype + CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p_UA: size of buffers for each call to pack subtype + CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, .TRUE. ) ! p_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! UA_Flag + Int_BufSz = Int_BufSz + 1 ! Vwnd_ND allocated yes/no + IF ( ALLOCATED(InData%Vwnd_ND) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vwnd_ND upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_ND) ! Vwnd_ND + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstCall, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%LE,3), UBOUND(InData%LE,3) + DO i2 = LBOUND(InData%LE,2), UBOUND(InData%LE,2) + DO i1 = LBOUND(InData%LE,1), UBOUND(InData%LE,1) + ReKiBuf(Re_Xferred) = InData%LE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%TE,3), UBOUND(InData%TE,3) + DO i2 = LBOUND(InData%TE,2), UBOUND(InData%TE,2) + DO i1 = LBOUND(InData%TE,1), UBOUND(InData%TE,1) + ReKiBuf(Re_Xferred) = InData%TE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%r_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%r_LL,4), UBOUND(InData%r_LL,4) + DO i3 = LBOUND(InData%r_LL,3), UBOUND(InData%r_LL,3) + DO i2 = LBOUND(InData%r_LL,2), UBOUND(InData%r_LL,2) + DO i1 = LBOUND(InData%r_LL,1), UBOUND(InData%r_LL,1) + ReKiBuf(Re_Xferred) = InData%r_LL(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%s_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%s_LL,2), UBOUND(InData%s_LL,2) + DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) + ReKiBuf(Re_Xferred) = InData%s_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%chord_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%chord_LL,2), UBOUND(InData%chord_LL,2) + DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) + ReKiBuf(Re_Xferred) = InData%chord_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%s_CP_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%s_CP_LL,2), UBOUND(InData%s_CP_LL,2) + DO i1 = LBOUND(InData%s_CP_LL,1), UBOUND(InData%s_CP_LL,1) + ReKiBuf(Re_Xferred) = InData%s_CP_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%chord_CP_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%chord_CP_LL,2), UBOUND(InData%chord_CP_LL,2) + DO i1 = LBOUND(InData%chord_CP_LL,1), UBOUND(InData%chord_CP_LL,1) + ReKiBuf(Re_Xferred) = InData%chord_CP_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CP_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%CP_LL,3), UBOUND(InData%CP_LL,3) + DO i2 = LBOUND(InData%CP_LL,2), UBOUND(InData%CP_LL,2) + DO i1 = LBOUND(InData%CP_LL,1), UBOUND(InData%CP_LL,1) + ReKiBuf(Re_Xferred) = InData%CP_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Tang) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Tang,3), UBOUND(InData%Tang,3) + DO i2 = LBOUND(InData%Tang,2), UBOUND(InData%Tang,2) + DO i1 = LBOUND(InData%Tang,1), UBOUND(InData%Tang,1) + ReKiBuf(Re_Xferred) = InData%Tang(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Norm) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Norm,3), UBOUND(InData%Norm,3) + DO i2 = LBOUND(InData%Norm,2), UBOUND(InData%Norm,2) + DO i1 = LBOUND(InData%Norm,1), UBOUND(InData%Norm,1) + ReKiBuf(Re_Xferred) = InData%Norm(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Orth) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Orth,3), UBOUND(InData%Orth,3) + DO i2 = LBOUND(InData%Orth,2), UBOUND(InData%Orth,2) + DO i1 = LBOUND(InData%Orth,1), UBOUND(InData%Orth,1) + ReKiBuf(Re_Xferred) = InData%Orth(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dl) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%dl,3), UBOUND(InData%dl,3) + DO i2 = LBOUND(InData%dl,2), UBOUND(InData%dl,2) + DO i1 = LBOUND(InData%dl,1), UBOUND(InData%dl,1) + ReKiBuf(Re_Xferred) = InData%dl(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Area) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Area,2), UBOUND(InData%Area,2) + DO i1 = LBOUND(InData%Area,1), UBOUND(InData%Area,1) + ReKiBuf(Re_Xferred) = InData%Area(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%diag_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%diag_LL,2), UBOUND(InData%diag_LL,2) + DO i1 = LBOUND(InData%diag_LL,1), UBOUND(InData%diag_LL,1) + ReKiBuf(Re_Xferred) = InData%diag_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Gamma_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Gamma_LL,2), UBOUND(InData%Gamma_LL,2) + DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) + ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vind_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vind_LL,3), UBOUND(InData%Vind_LL,3) + DO i2 = LBOUND(InData%Vind_LL,2), UBOUND(InData%Vind_LL,2) + DO i1 = LBOUND(InData%Vind_LL,1), UBOUND(InData%Vind_LL,1) + ReKiBuf(Re_Xferred) = InData%Vind_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vtot_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vtot_LL,3), UBOUND(InData%Vtot_LL,3) + DO i2 = LBOUND(InData%Vtot_LL,2), UBOUND(InData%Vtot_LL,2) + DO i1 = LBOUND(InData%Vtot_LL,1), UBOUND(InData%Vtot_LL,1) + ReKiBuf(Re_Xferred) = InData%Vtot_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vstr_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vstr_LL,3), UBOUND(InData%Vstr_LL,3) + DO i2 = LBOUND(InData%Vstr_LL,2), UBOUND(InData%Vstr_LL,2) + DO i1 = LBOUND(InData%Vstr_LL,1), UBOUND(InData%Vstr_LL,1) + ReKiBuf(Re_Xferred) = InData%Vstr_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vwnd_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vwnd_LL,3), UBOUND(InData%Vwnd_LL,3) + DO i2 = LBOUND(InData%Vwnd_LL,2), UBOUND(InData%Vwnd_LL,2) + DO i1 = LBOUND(InData%Vwnd_LL,1), UBOUND(InData%Vwnd_LL,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vwnd_NW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Vwnd_NW,4), UBOUND(InData%Vwnd_NW,4) + DO i3 = LBOUND(InData%Vwnd_NW,3), UBOUND(InData%Vwnd_NW,3) + DO i2 = LBOUND(InData%Vwnd_NW,2), UBOUND(InData%Vwnd_NW,2) + DO i1 = LBOUND(InData%Vwnd_NW,1), UBOUND(InData%Vwnd_NW,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vwnd_FW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Vwnd_FW,4), UBOUND(InData%Vwnd_FW,4) + DO i3 = LBOUND(InData%Vwnd_FW,3), UBOUND(InData%Vwnd_FW,3) + DO i2 = LBOUND(InData%Vwnd_FW,2), UBOUND(InData%Vwnd_FW,2) + DO i1 = LBOUND(InData%Vwnd_FW,1), UBOUND(InData%Vwnd_FW,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vind_NW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Vind_NW,4), UBOUND(InData%Vind_NW,4) + DO i3 = LBOUND(InData%Vind_NW,3), UBOUND(InData%Vind_NW,3) + DO i2 = LBOUND(InData%Vind_NW,2), UBOUND(InData%Vind_NW,2) + DO i1 = LBOUND(InData%Vind_NW,1), UBOUND(InData%Vind_NW,1) + ReKiBuf(Re_Xferred) = InData%Vind_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vind_FW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Vind_FW,4), UBOUND(InData%Vind_FW,4) + DO i3 = LBOUND(InData%Vind_FW,3), UBOUND(InData%Vind_FW,3) + DO i2 = LBOUND(InData%Vind_FW,2), UBOUND(InData%Vind_FW,2) + DO i1 = LBOUND(InData%Vind_FW,1), UBOUND(InData%Vind_FW,1) + ReKiBuf(Re_Xferred) = InData%Vind_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nNW + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFW + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iStep + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKstep + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%VTKlastTime + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%r_wind) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%r_wind,2), UBOUND(InData%r_wind,2) + DO i1 = LBOUND(InData%r_wind,1), UBOUND(InData%r_wind,1) + ReKiBuf(Re_Xferred) = InData%r_wind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PitchAndTwist) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PitchAndTwist,2), UBOUND(InData%PitchAndTwist,2) + DO i1 = LBOUND(InData%PitchAndTwist,1), UBOUND(InData%PitchAndTwist,1) + ReKiBuf(Re_Xferred) = InData%PitchAndTwist(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%ComputeWakeInduced, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%OldWakeTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tSpent + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%dxdt_NW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%dxdt_NW,4), UBOUND(InData%dxdt_NW,4) + DO i3 = LBOUND(InData%dxdt_NW,3), UBOUND(InData%dxdt_NW,3) + DO i2 = LBOUND(InData%dxdt_NW,2), UBOUND(InData%dxdt_NW,2) + DO i1 = LBOUND(InData%dxdt_NW,1), UBOUND(InData%dxdt_NW,1) + ReKiBuf(Re_Xferred) = InData%dxdt_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dxdt_FW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%dxdt_FW,4), UBOUND(InData%dxdt_FW,4) + DO i3 = LBOUND(InData%dxdt_FW,3), UBOUND(InData%dxdt_FW,3) + DO i2 = LBOUND(InData%dxdt_FW,2), UBOUND(InData%dxdt_FW,2) + DO i1 = LBOUND(InData%dxdt_FW,1), UBOUND(InData%dxdt_FW,1) + ReKiBuf(Re_Xferred) = InData%dxdt_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%alpha_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%alpha_LL,2), UBOUND(InData%alpha_LL,2) + DO i1 = LBOUND(InData%alpha_LL,1), UBOUND(InData%alpha_LL,1) + ReKiBuf(Re_Xferred) = InData%alpha_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Vreln_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Vreln_LL,2), UBOUND(InData%Vreln_LL,2) + DO i1 = LBOUND(InData%Vreln_LL,1), UBOUND(InData%Vreln_LL,1) + ReKiBuf(Re_Xferred) = InData%Vreln_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SegConnct) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SegConnct,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegConnct,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SegConnct,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegConnct,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%SegConnct,2), UBOUND(InData%SegConnct,2) + DO i1 = LBOUND(InData%SegConnct,1), UBOUND(InData%SegConnct,1) + IntKiBuf(Int_Xferred) = InData%SegConnct(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SegPoints) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SegPoints,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegPoints,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SegPoints,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegPoints,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%SegPoints,2), UBOUND(InData%SegPoints,2) + DO i1 = LBOUND(InData%SegPoints,1), UBOUND(InData%SegPoints,1) + ReKiBuf(Re_Xferred) = InData%SegPoints(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SegGamma) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SegGamma,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegGamma,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SegGamma,1), UBOUND(InData%SegGamma,1) + ReKiBuf(Re_Xferred) = InData%SegGamma(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SegEpsilon) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SegEpsilon,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegEpsilon,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SegEpsilon,1), UBOUND(InData%SegEpsilon,1) + ReKiBuf(Re_Xferred) = InData%SegEpsilon(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CPs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CPs,2), UBOUND(InData%CPs,2) + DO i1 = LBOUND(InData%CPs,1), UBOUND(InData%CPs,1) + ReKiBuf(Re_Xferred) = InData%CPs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Uind) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Uind,2), UBOUND(InData%Uind,2) + DO i1 = LBOUND(InData%Uind,1), UBOUND(InData%Uind,1) + ReKiBuf(Re_Xferred) = InData%Uind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_AxInd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_AxInd,2), UBOUND(InData%BN_AxInd,2) + DO i1 = LBOUND(InData%BN_AxInd,1), UBOUND(InData%BN_AxInd,1) + ReKiBuf(Re_Xferred) = InData%BN_AxInd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_TanInd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_TanInd,2), UBOUND(InData%BN_TanInd,2) + DO i1 = LBOUND(InData%BN_TanInd,1), UBOUND(InData%BN_TanInd,1) + ReKiBuf(Re_Xferred) = InData%BN_TanInd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Vrel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Vrel,2), UBOUND(InData%BN_Vrel,2) + DO i1 = LBOUND(InData%BN_Vrel,1), UBOUND(InData%BN_Vrel,1) + ReKiBuf(Re_Xferred) = InData%BN_Vrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_alpha) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_alpha,2), UBOUND(InData%BN_alpha,2) + DO i1 = LBOUND(InData%BN_alpha,1), UBOUND(InData%BN_alpha,1) + ReKiBuf(Re_Xferred) = InData%BN_alpha(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_phi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_phi,2), UBOUND(InData%BN_phi,2) + DO i1 = LBOUND(InData%BN_phi,1), UBOUND(InData%BN_phi,1) + ReKiBuf(Re_Xferred) = InData%BN_phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Re) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Re,2), UBOUND(InData%BN_Re,2) + DO i1 = LBOUND(InData%BN_Re,1), UBOUND(InData%BN_Re,1) + ReKiBuf(Re_Xferred) = InData%BN_Re(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_URelWind_s) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%BN_URelWind_s,3), UBOUND(InData%BN_URelWind_s,3) + DO i2 = LBOUND(InData%BN_URelWind_s,2), UBOUND(InData%BN_URelWind_s,2) + DO i1 = LBOUND(InData%BN_URelWind_s,1), UBOUND(InData%BN_URelWind_s,1) + ReKiBuf(Re_Xferred) = InData%BN_URelWind_s(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cl_Static) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cl_Static,2), UBOUND(InData%BN_Cl_Static,2) + DO i1 = LBOUND(InData%BN_Cl_Static,1), UBOUND(InData%BN_Cl_Static,1) + ReKiBuf(Re_Xferred) = InData%BN_Cl_Static(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cd_Static) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cd_Static,2), UBOUND(InData%BN_Cd_Static,2) + DO i1 = LBOUND(InData%BN_Cd_Static,1), UBOUND(InData%BN_Cd_Static,1) + ReKiBuf(Re_Xferred) = InData%BN_Cd_Static(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cm_Static) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cm_Static,2), UBOUND(InData%BN_Cm_Static,2) + DO i1 = LBOUND(InData%BN_Cm_Static,1), UBOUND(InData%BN_Cm_Static,1) + ReKiBuf(Re_Xferred) = InData%BN_Cm_Static(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cl) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cl,2), UBOUND(InData%BN_Cl,2) + DO i1 = LBOUND(InData%BN_Cl,1), UBOUND(InData%BN_Cl,1) + ReKiBuf(Re_Xferred) = InData%BN_Cl(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cd,2), UBOUND(InData%BN_Cd,2) + DO i1 = LBOUND(InData%BN_Cd,1), UBOUND(InData%BN_Cd,1) + ReKiBuf(Re_Xferred) = InData%BN_Cd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cm) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cm,2), UBOUND(InData%BN_Cm,2) + DO i1 = LBOUND(InData%BN_Cm,1), UBOUND(InData%BN_Cm,1) + ReKiBuf(Re_Xferred) = InData%BN_Cm(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cx,2), UBOUND(InData%BN_Cx,2) + DO i1 = LBOUND(InData%BN_Cx,1), UBOUND(InData%BN_Cx,1) + ReKiBuf(Re_Xferred) = InData%BN_Cx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BN_Cy) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cy,2), UBOUND(InData%BN_Cy,2) + DO i1 = LBOUND(InData%BN_Cy,1), UBOUND(InData%BN_Cy,1) + ReKiBuf(Re_Xferred) = InData%BN_Cy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, OnlySize ) ! p_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Vwnd_ND) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_ND,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_ND,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_ND,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_ND,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_ND,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_ND,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vwnd_ND,3), UBOUND(InData%Vwnd_ND,3) + DO i2 = LBOUND(InData%Vwnd_ND,2), UBOUND(InData%Vwnd_ND,2) + DO i1 = LBOUND(InData%Vwnd_ND,1), UBOUND(InData%Vwnd_ND,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_ND(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FVW_PackMisc + + SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%FirstCall = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstCall) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LE)) DEALLOCATE(OutData%LE) + ALLOCATE(OutData%LE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%LE,3), UBOUND(OutData%LE,3) + DO i2 = LBOUND(OutData%LE,2), UBOUND(OutData%LE,2) + DO i1 = LBOUND(OutData%LE,1), UBOUND(OutData%LE,1) + OutData%LE(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 ! TE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TE)) DEALLOCATE(OutData%TE) + ALLOCATE(OutData%TE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%TE,3), UBOUND(OutData%TE,3) + DO i2 = LBOUND(OutData%TE,2), UBOUND(OutData%TE,2) + DO i1 = LBOUND(OutData%TE,1), UBOUND(OutData%TE,1) + OutData%TE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%r_LL)) DEALLOCATE(OutData%r_LL) + ALLOCATE(OutData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%r_LL,4), UBOUND(OutData%r_LL,4) + DO i3 = LBOUND(OutData%r_LL,3), UBOUND(OutData%r_LL,3) + DO i2 = LBOUND(OutData%r_LL,2), UBOUND(OutData%r_LL,2) + DO i1 = LBOUND(OutData%r_LL,1), UBOUND(OutData%r_LL,1) + OutData%r_LL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%s_LL)) DEALLOCATE(OutData%s_LL) + ALLOCATE(OutData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%s_LL,2), UBOUND(OutData%s_LL,2) + DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) + OutData%s_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%chord_LL)) DEALLOCATE(OutData%chord_LL) + ALLOCATE(OutData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%chord_LL,2), UBOUND(OutData%chord_LL,2) + DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) + OutData%chord_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%s_CP_LL)) DEALLOCATE(OutData%s_CP_LL) + ALLOCATE(OutData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%s_CP_LL,2), UBOUND(OutData%s_CP_LL,2) + DO i1 = LBOUND(OutData%s_CP_LL,1), UBOUND(OutData%s_CP_LL,1) + OutData%s_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%chord_CP_LL)) DEALLOCATE(OutData%chord_CP_LL) + ALLOCATE(OutData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%chord_CP_LL,2), UBOUND(OutData%chord_CP_LL,2) + DO i1 = LBOUND(OutData%chord_CP_LL,1), UBOUND(OutData%chord_CP_LL,1) + OutData%chord_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CP_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CP_LL)) DEALLOCATE(OutData%CP_LL) + ALLOCATE(OutData%CP_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%CP_LL,3), UBOUND(OutData%CP_LL,3) + DO i2 = LBOUND(OutData%CP_LL,2), UBOUND(OutData%CP_LL,2) + DO i1 = LBOUND(OutData%CP_LL,1), UBOUND(OutData%CP_LL,1) + OutData%CP_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tang not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Tang)) DEALLOCATE(OutData%Tang) + ALLOCATE(OutData%Tang(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Tang,3), UBOUND(OutData%Tang,3) + DO i2 = LBOUND(OutData%Tang,2), UBOUND(OutData%Tang,2) + DO i1 = LBOUND(OutData%Tang,1), UBOUND(OutData%Tang,1) + OutData%Tang(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 ! Norm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Norm)) DEALLOCATE(OutData%Norm) + ALLOCATE(OutData%Norm(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Norm,3), UBOUND(OutData%Norm,3) + DO i2 = LBOUND(OutData%Norm,2), UBOUND(OutData%Norm,2) + DO i1 = LBOUND(OutData%Norm,1), UBOUND(OutData%Norm,1) + OutData%Norm(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 ! Orth not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Orth)) DEALLOCATE(OutData%Orth) + ALLOCATE(OutData%Orth(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Orth,3), UBOUND(OutData%Orth,3) + DO i2 = LBOUND(OutData%Orth,2), UBOUND(OutData%Orth,2) + DO i1 = LBOUND(OutData%Orth,1), UBOUND(OutData%Orth,1) + OutData%Orth(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 ! dl not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dl)) DEALLOCATE(OutData%dl) + ALLOCATE(OutData%dl(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%dl,3), UBOUND(OutData%dl,3) + DO i2 = LBOUND(OutData%dl,2), UBOUND(OutData%dl,2) + DO i1 = LBOUND(OutData%dl,1), UBOUND(OutData%dl,1) + OutData%dl(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 ! Area not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Area)) DEALLOCATE(OutData%Area) + ALLOCATE(OutData%Area(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Area,2), UBOUND(OutData%Area,2) + DO i1 = LBOUND(OutData%Area,1), UBOUND(OutData%Area,1) + OutData%Area(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! diag_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%diag_LL)) DEALLOCATE(OutData%diag_LL) + ALLOCATE(OutData%diag_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%diag_LL,2), UBOUND(OutData%diag_LL,2) + DO i1 = LBOUND(OutData%diag_LL,1), UBOUND(OutData%diag_LL,1) + OutData%diag_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) + ALLOCATE(OutData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Gamma_LL,2), UBOUND(OutData%Gamma_LL,2) + DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) + OutData%Gamma_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vind_LL)) DEALLOCATE(OutData%Vind_LL) + ALLOCATE(OutData%Vind_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vind_LL,3), UBOUND(OutData%Vind_LL,3) + DO i2 = LBOUND(OutData%Vind_LL,2), UBOUND(OutData%Vind_LL,2) + DO i1 = LBOUND(OutData%Vind_LL,1), UBOUND(OutData%Vind_LL,1) + OutData%Vind_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vtot_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vtot_LL)) DEALLOCATE(OutData%Vtot_LL) + ALLOCATE(OutData%Vtot_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vtot_LL,3), UBOUND(OutData%Vtot_LL,3) + DO i2 = LBOUND(OutData%Vtot_LL,2), UBOUND(OutData%Vtot_LL,2) + DO i1 = LBOUND(OutData%Vtot_LL,1), UBOUND(OutData%Vtot_LL,1) + OutData%Vtot_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vstr_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vstr_LL)) DEALLOCATE(OutData%Vstr_LL) + ALLOCATE(OutData%Vstr_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vstr_LL,3), UBOUND(OutData%Vstr_LL,3) + DO i2 = LBOUND(OutData%Vstr_LL,2), UBOUND(OutData%Vstr_LL,2) + DO i1 = LBOUND(OutData%Vstr_LL,1), UBOUND(OutData%Vstr_LL,1) + OutData%Vstr_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vwnd_LL)) DEALLOCATE(OutData%Vwnd_LL) + ALLOCATE(OutData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vwnd_LL,3), UBOUND(OutData%Vwnd_LL,3) + DO i2 = LBOUND(OutData%Vwnd_LL,2), UBOUND(OutData%Vwnd_LL,2) + DO i1 = LBOUND(OutData%Vwnd_LL,1), UBOUND(OutData%Vwnd_LL,1) + OutData%Vwnd_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_NW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vwnd_NW)) DEALLOCATE(OutData%Vwnd_NW) + ALLOCATE(OutData%Vwnd_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Vwnd_NW,4), UBOUND(OutData%Vwnd_NW,4) + DO i3 = LBOUND(OutData%Vwnd_NW,3), UBOUND(OutData%Vwnd_NW,3) + DO i2 = LBOUND(OutData%Vwnd_NW,2), UBOUND(OutData%Vwnd_NW,2) + DO i1 = LBOUND(OutData%Vwnd_NW,1), UBOUND(OutData%Vwnd_NW,1) + OutData%Vwnd_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_FW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vwnd_FW)) DEALLOCATE(OutData%Vwnd_FW) + ALLOCATE(OutData%Vwnd_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Vwnd_FW,4), UBOUND(OutData%Vwnd_FW,4) + DO i3 = LBOUND(OutData%Vwnd_FW,3), UBOUND(OutData%Vwnd_FW,3) + DO i2 = LBOUND(OutData%Vwnd_FW,2), UBOUND(OutData%Vwnd_FW,2) + DO i1 = LBOUND(OutData%Vwnd_FW,1), UBOUND(OutData%Vwnd_FW,1) + OutData%Vwnd_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_NW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vind_NW)) DEALLOCATE(OutData%Vind_NW) + ALLOCATE(OutData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Vind_NW,4), UBOUND(OutData%Vind_NW,4) + DO i3 = LBOUND(OutData%Vind_NW,3), UBOUND(OutData%Vind_NW,3) + DO i2 = LBOUND(OutData%Vind_NW,2), UBOUND(OutData%Vind_NW,2) + DO i1 = LBOUND(OutData%Vind_NW,1), UBOUND(OutData%Vind_NW,1) + OutData%Vind_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_FW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vind_FW)) DEALLOCATE(OutData%Vind_FW) + ALLOCATE(OutData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Vind_FW,4), UBOUND(OutData%Vind_FW,4) + DO i3 = LBOUND(OutData%Vind_FW,3), UBOUND(OutData%Vind_FW,3) + DO i2 = LBOUND(OutData%Vind_FW,2), UBOUND(OutData%Vind_FW,2) + DO i1 = LBOUND(OutData%Vind_FW,1), UBOUND(OutData%Vind_FW,1) + OutData%Vind_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + OutData%nNW = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFW = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iStep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKstep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKlastTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wind not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%r_wind)) DEALLOCATE(OutData%r_wind) + ALLOCATE(OutData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%r_wind,2), UBOUND(OutData%r_wind,2) + DO i1 = LBOUND(OutData%r_wind,1), UBOUND(OutData%r_wind,1) + OutData%r_wind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAndTwist not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PitchAndTwist)) DEALLOCATE(OutData%PitchAndTwist) + ALLOCATE(OutData%PitchAndTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PitchAndTwist,2), UBOUND(OutData%PitchAndTwist,2) + DO i1 = LBOUND(OutData%PitchAndTwist,1), UBOUND(OutData%PitchAndTwist,1) + OutData%PitchAndTwist(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%ComputeWakeInduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%ComputeWakeInduced) + Int_Xferred = Int_Xferred + 1 + OutData%OldWakeTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%tSpent = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxdt_NW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dxdt_NW)) DEALLOCATE(OutData%dxdt_NW) + ALLOCATE(OutData%dxdt_NW(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%dxdt_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%dxdt_NW,4), UBOUND(OutData%dxdt_NW,4) + DO i3 = LBOUND(OutData%dxdt_NW,3), UBOUND(OutData%dxdt_NW,3) + DO i2 = LBOUND(OutData%dxdt_NW,2), UBOUND(OutData%dxdt_NW,2) + DO i1 = LBOUND(OutData%dxdt_NW,1), UBOUND(OutData%dxdt_NW,1) + OutData%dxdt_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxdt_FW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dxdt_FW)) DEALLOCATE(OutData%dxdt_FW) + ALLOCATE(OutData%dxdt_FW(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%dxdt_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%dxdt_FW,4), UBOUND(OutData%dxdt_FW,4) + DO i3 = LBOUND(OutData%dxdt_FW,3), UBOUND(OutData%dxdt_FW,3) + DO i2 = LBOUND(OutData%dxdt_FW,2), UBOUND(OutData%dxdt_FW,2) + DO i1 = LBOUND(OutData%dxdt_FW,1), UBOUND(OutData%dxdt_FW,1) + OutData%dxdt_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%alpha_LL)) DEALLOCATE(OutData%alpha_LL) + ALLOCATE(OutData%alpha_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%alpha_LL,2), UBOUND(OutData%alpha_LL,2) + DO i1 = LBOUND(OutData%alpha_LL,1), UBOUND(OutData%alpha_LL,1) + OutData%alpha_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vreln_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vreln_LL)) DEALLOCATE(OutData%Vreln_LL) + ALLOCATE(OutData%Vreln_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Vreln_LL,2), UBOUND(OutData%Vreln_LL,2) + DO i1 = LBOUND(OutData%Vreln_LL,1), UBOUND(OutData%Vreln_LL,1) + OutData%Vreln_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegConnct not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SegConnct)) DEALLOCATE(OutData%SegConnct) + ALLOCATE(OutData%SegConnct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegConnct.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%SegConnct,2), UBOUND(OutData%SegConnct,2) + DO i1 = LBOUND(OutData%SegConnct,1), UBOUND(OutData%SegConnct,1) + OutData%SegConnct(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegPoints not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SegPoints)) DEALLOCATE(OutData%SegPoints) + ALLOCATE(OutData%SegPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegPoints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%SegPoints,2), UBOUND(OutData%SegPoints,2) + DO i1 = LBOUND(OutData%SegPoints,1), UBOUND(OutData%SegPoints,1) + OutData%SegPoints(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegGamma not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SegGamma)) DEALLOCATE(OutData%SegGamma) + ALLOCATE(OutData%SegGamma(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegGamma.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SegGamma,1), UBOUND(OutData%SegGamma,1) + OutData%SegGamma(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegEpsilon not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SegEpsilon)) DEALLOCATE(OutData%SegEpsilon) + ALLOCATE(OutData%SegEpsilon(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegEpsilon.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SegEpsilon,1), UBOUND(OutData%SegEpsilon,1) + OutData%SegEpsilon(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CPs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CPs)) DEALLOCATE(OutData%CPs) + ALLOCATE(OutData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CPs,2), UBOUND(OutData%CPs,2) + DO i1 = LBOUND(OutData%CPs,1), UBOUND(OutData%CPs,1) + OutData%CPs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Uind not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Uind)) DEALLOCATE(OutData%Uind) + ALLOCATE(OutData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Uind,2), UBOUND(OutData%Uind,2) + DO i1 = LBOUND(OutData%Uind,1), UBOUND(OutData%Uind,1) + OutData%Uind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_AxInd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_AxInd)) DEALLOCATE(OutData%BN_AxInd) + ALLOCATE(OutData%BN_AxInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_AxInd,2), UBOUND(OutData%BN_AxInd,2) + DO i1 = LBOUND(OutData%BN_AxInd,1), UBOUND(OutData%BN_AxInd,1) + OutData%BN_AxInd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_TanInd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_TanInd)) DEALLOCATE(OutData%BN_TanInd) + ALLOCATE(OutData%BN_TanInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_TanInd,2), UBOUND(OutData%BN_TanInd,2) + DO i1 = LBOUND(OutData%BN_TanInd,1), UBOUND(OutData%BN_TanInd,1) + OutData%BN_TanInd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Vrel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Vrel)) DEALLOCATE(OutData%BN_Vrel) + ALLOCATE(OutData%BN_Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Vrel,2), UBOUND(OutData%BN_Vrel,2) + DO i1 = LBOUND(OutData%BN_Vrel,1), UBOUND(OutData%BN_Vrel,1) + OutData%BN_Vrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_alpha not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_alpha)) DEALLOCATE(OutData%BN_alpha) + ALLOCATE(OutData%BN_alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_alpha,2), UBOUND(OutData%BN_alpha,2) + DO i1 = LBOUND(OutData%BN_alpha,1), UBOUND(OutData%BN_alpha,1) + OutData%BN_alpha(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_phi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_phi)) DEALLOCATE(OutData%BN_phi) + ALLOCATE(OutData%BN_phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_phi,2), UBOUND(OutData%BN_phi,2) + DO i1 = LBOUND(OutData%BN_phi,1), UBOUND(OutData%BN_phi,1) + OutData%BN_phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Re not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Re)) DEALLOCATE(OutData%BN_Re) + ALLOCATE(OutData%BN_Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Re,2), UBOUND(OutData%BN_Re,2) + DO i1 = LBOUND(OutData%BN_Re,1), UBOUND(OutData%BN_Re,1) + OutData%BN_Re(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_URelWind_s not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_URelWind_s)) DEALLOCATE(OutData%BN_URelWind_s) + ALLOCATE(OutData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BN_URelWind_s,3), UBOUND(OutData%BN_URelWind_s,3) + DO i2 = LBOUND(OutData%BN_URelWind_s,2), UBOUND(OutData%BN_URelWind_s,2) + DO i1 = LBOUND(OutData%BN_URelWind_s,1), UBOUND(OutData%BN_URelWind_s,1) + OutData%BN_URelWind_s(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl_Static not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cl_Static)) DEALLOCATE(OutData%BN_Cl_Static) + ALLOCATE(OutData%BN_Cl_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cl_Static,2), UBOUND(OutData%BN_Cl_Static,2) + DO i1 = LBOUND(OutData%BN_Cl_Static,1), UBOUND(OutData%BN_Cl_Static,1) + OutData%BN_Cl_Static(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd_Static not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cd_Static)) DEALLOCATE(OutData%BN_Cd_Static) + ALLOCATE(OutData%BN_Cd_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cd_Static,2), UBOUND(OutData%BN_Cd_Static,2) + DO i1 = LBOUND(OutData%BN_Cd_Static,1), UBOUND(OutData%BN_Cd_Static,1) + OutData%BN_Cd_Static(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm_Static not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cm_Static)) DEALLOCATE(OutData%BN_Cm_Static) + ALLOCATE(OutData%BN_Cm_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cm_Static,2), UBOUND(OutData%BN_Cm_Static,2) + DO i1 = LBOUND(OutData%BN_Cm_Static,1), UBOUND(OutData%BN_Cm_Static,1) + OutData%BN_Cm_Static(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cl)) DEALLOCATE(OutData%BN_Cl) + ALLOCATE(OutData%BN_Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cl,2), UBOUND(OutData%BN_Cl,2) + DO i1 = LBOUND(OutData%BN_Cl,1), UBOUND(OutData%BN_Cl,1) + OutData%BN_Cl(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cd)) DEALLOCATE(OutData%BN_Cd) + ALLOCATE(OutData%BN_Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cd,2), UBOUND(OutData%BN_Cd,2) + DO i1 = LBOUND(OutData%BN_Cd,1), UBOUND(OutData%BN_Cd,1) + OutData%BN_Cd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cm)) DEALLOCATE(OutData%BN_Cm) + ALLOCATE(OutData%BN_Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cm,2), UBOUND(OutData%BN_Cm,2) + DO i1 = LBOUND(OutData%BN_Cm,1), UBOUND(OutData%BN_Cm,1) + OutData%BN_Cm(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cx)) DEALLOCATE(OutData%BN_Cx) + ALLOCATE(OutData%BN_Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cx,2), UBOUND(OutData%BN_Cx,2) + DO i1 = LBOUND(OutData%BN_Cx,1), UBOUND(OutData%BN_Cx,1) + OutData%BN_Cx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cy not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cy)) DEALLOCATE(OutData%BN_Cy) + ALLOCATE(OutData%BN_Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cy,2), UBOUND(OutData%BN_Cy,2) + DO i1 = LBOUND(OutData%BN_Cy,1), UBOUND(OutData%BN_Cy,1) + OutData%BN_Cy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_UA, ErrStat2, ErrMsg2 ) ! m_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_UA, ErrStat2, ErrMsg2 ) ! p_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_ND not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vwnd_ND)) DEALLOCATE(OutData%Vwnd_ND) + ALLOCATE(OutData%Vwnd_ND(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_ND.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vwnd_ND,3), UBOUND(OutData%Vwnd_ND,3) + DO i2 = LBOUND(OutData%Vwnd_ND,2), UBOUND(OutData%Vwnd_ND,2) + DO i1 = LBOUND(OutData%Vwnd_ND,1), UBOUND(OutData%Vwnd_ND,1) + OutData%Vwnd_ND(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FVW_UnPackMisc + + SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData + TYPE(FVW_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInputData%WingsMesh)) THEN + i1_l = LBOUND(SrcInputData%WingsMesh,1) + i1_u = UBOUND(SrcInputData%WingsMesh,1) + IF (.NOT. ALLOCATED(DstInputData%WingsMesh)) THEN + ALLOCATE(DstInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputData%WingsMesh,1), UBOUND(SrcInputData%WingsMesh,1) + CALL MeshCopy( SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcInputData%V_wind)) THEN + i1_l = LBOUND(SrcInputData%V_wind,1) + i1_u = UBOUND(SrcInputData%V_wind,1) + i2_l = LBOUND(SrcInputData%V_wind,2) + i2_u = UBOUND(SrcInputData%V_wind,2) + IF (.NOT. ALLOCATED(DstInputData%V_wind)) THEN + ALLOCATE(DstInputData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%V_wind = SrcInputData%V_wind +ENDIF + DstInputData%HubOrientation = SrcInputData%HubOrientation + DstInputData%HubPosition = SrcInputData%HubPosition + END SUBROUTINE FVW_CopyInput + + SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(FVW_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InputData%WingsMesh)) THEN +DO i1 = LBOUND(InputData%WingsMesh,1), UBOUND(InputData%WingsMesh,1) + CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InputData%WingsMesh) +ENDIF +IF (ALLOCATED(InputData%V_wind)) THEN + DEALLOCATE(InputData%V_wind) +ENDIF + END SUBROUTINE FVW_DestroyInput + + SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no + IF ( ALLOCATED(InData%WingsMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) + Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! V_wind allocated yes/no + IF ( ALLOCATED(InData%V_wind) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! V_wind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%V_wind) ! V_wind + END IF + Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation + Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WingsMesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) + CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%V_wind) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%V_wind,2), UBOUND(InData%V_wind,2) + DO i1 = LBOUND(InData%V_wind,1), UBOUND(InData%V_wind,1) + ReKiBuf(Re_Xferred) = InData%V_wind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) + DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) + ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FVW_PackInput + + SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WingsMesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WingsMesh)) DEALLOCATE(OutData%WingsMesh) + ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_wind not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%V_wind)) DEALLOCATE(OutData%V_wind) + ALLOCATE(OutData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%V_wind,2), UBOUND(OutData%V_wind,2) + DO i1 = LBOUND(OutData%V_wind,1), UBOUND(OutData%V_wind,1) + OutData%V_wind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + i1_l = LBOUND(OutData%HubOrientation,1) + i1_u = UBOUND(OutData%HubOrientation,1) + i2_l = LBOUND(OutData%HubOrientation,2) + i2_u = UBOUND(OutData%HubOrientation,2) + DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) + DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) + OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%HubPosition,1) + i1_u = UBOUND(OutData%HubPosition,1) + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FVW_UnPackInput + + SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData + TYPE(FVW_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOutputData%Vind)) THEN + i1_l = LBOUND(SrcOutputData%Vind,1) + i1_u = UBOUND(SrcOutputData%Vind,1) + i2_l = LBOUND(SrcOutputData%Vind,2) + i2_u = UBOUND(SrcOutputData%Vind,2) + i3_l = LBOUND(SrcOutputData%Vind,3) + i3_u = UBOUND(SrcOutputData%Vind,3) + IF (.NOT. ALLOCATED(DstOutputData%Vind)) THEN + ALLOCATE(DstOutputData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Vind = SrcOutputData%Vind +ENDIF +IF (ALLOCATED(SrcOutputData%Cl_KJ)) THEN + i1_l = LBOUND(SrcOutputData%Cl_KJ,1) + i1_u = UBOUND(SrcOutputData%Cl_KJ,1) + i2_l = LBOUND(SrcOutputData%Cl_KJ,2) + i2_u = UBOUND(SrcOutputData%Cl_KJ,2) + IF (.NOT. ALLOCATED(DstOutputData%Cl_KJ)) THEN + ALLOCATE(DstOutputData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Cl_KJ = SrcOutputData%Cl_KJ +ENDIF + END SUBROUTINE FVW_CopyOutput + + SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OutputData%Vind)) THEN + DEALLOCATE(OutputData%Vind) +ENDIF +IF (ALLOCATED(OutputData%Cl_KJ)) THEN + DEALLOCATE(OutputData%Cl_KJ) +ENDIF + END SUBROUTINE FVW_DestroyOutput + + SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Vind allocated yes/no + IF ( ALLOCATED(InData%Vind) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind + END IF + Int_BufSz = Int_BufSz + 1 ! Cl_KJ allocated yes/no + IF ( ALLOCATED(InData%Cl_KJ) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Cl_KJ upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Cl_KJ) ! Cl_KJ + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%Vind) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vind,3), UBOUND(InData%Vind,3) + DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) + DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) + ReKiBuf(Re_Xferred) = InData%Vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Cl_KJ) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Cl_KJ,2), UBOUND(InData%Cl_KJ,2) + DO i1 = LBOUND(InData%Cl_KJ,1), UBOUND(InData%Cl_KJ,1) + ReKiBuf(Re_Xferred) = InData%Cl_KJ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FVW_PackOutput + + SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vind)) DEALLOCATE(OutData%Vind) + ALLOCATE(OutData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vind,3), UBOUND(OutData%Vind,3) + DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) + DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) + OutData%Vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl_KJ not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Cl_KJ)) DEALLOCATE(OutData%Cl_KJ) + ALLOCATE(OutData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Cl_KJ,2), UBOUND(OutData%Cl_KJ,2) + DO i1 = LBOUND(OutData%Cl_KJ,1), UBOUND(OutData%Cl_KJ,1) + OutData%Cl_KJ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FVW_UnPackOutput + + SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcContStateData%Gamma_NW)) THEN + i1_l = LBOUND(SrcContStateData%Gamma_NW,1) + i1_u = UBOUND(SrcContStateData%Gamma_NW,1) + i2_l = LBOUND(SrcContStateData%Gamma_NW,2) + i2_u = UBOUND(SrcContStateData%Gamma_NW,2) + i3_l = LBOUND(SrcContStateData%Gamma_NW,3) + i3_u = UBOUND(SrcContStateData%Gamma_NW,3) + IF (.NOT. ALLOCATED(DstContStateData%Gamma_NW)) THEN + ALLOCATE(DstContStateData%Gamma_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%Gamma_NW = SrcContStateData%Gamma_NW +ENDIF +IF (ALLOCATED(SrcContStateData%Gamma_FW)) THEN + i1_l = LBOUND(SrcContStateData%Gamma_FW,1) + i1_u = UBOUND(SrcContStateData%Gamma_FW,1) + i2_l = LBOUND(SrcContStateData%Gamma_FW,2) + i2_u = UBOUND(SrcContStateData%Gamma_FW,2) + i3_l = LBOUND(SrcContStateData%Gamma_FW,3) + i3_u = UBOUND(SrcContStateData%Gamma_FW,3) + IF (.NOT. ALLOCATED(DstContStateData%Gamma_FW)) THEN + ALLOCATE(DstContStateData%Gamma_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%Gamma_FW = SrcContStateData%Gamma_FW +ENDIF +IF (ALLOCATED(SrcContStateData%r_NW)) THEN + i1_l = LBOUND(SrcContStateData%r_NW,1) + i1_u = UBOUND(SrcContStateData%r_NW,1) + i2_l = LBOUND(SrcContStateData%r_NW,2) + i2_u = UBOUND(SrcContStateData%r_NW,2) + i3_l = LBOUND(SrcContStateData%r_NW,3) + i3_u = UBOUND(SrcContStateData%r_NW,3) + i4_l = LBOUND(SrcContStateData%r_NW,4) + i4_u = UBOUND(SrcContStateData%r_NW,4) + IF (.NOT. ALLOCATED(DstContStateData%r_NW)) THEN + ALLOCATE(DstContStateData%r_NW(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 DstContStateData%r_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%r_NW = SrcContStateData%r_NW +ENDIF +IF (ALLOCATED(SrcContStateData%r_FW)) THEN + i1_l = LBOUND(SrcContStateData%r_FW,1) + i1_u = UBOUND(SrcContStateData%r_FW,1) + i2_l = LBOUND(SrcContStateData%r_FW,2) + i2_u = UBOUND(SrcContStateData%r_FW,2) + i3_l = LBOUND(SrcContStateData%r_FW,3) + i3_u = UBOUND(SrcContStateData%r_FW,3) + i4_l = LBOUND(SrcContStateData%r_FW,4) + i4_u = UBOUND(SrcContStateData%r_FW,4) + IF (.NOT. ALLOCATED(DstContStateData%r_FW)) THEN + ALLOCATE(DstContStateData%r_FW(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 DstContStateData%r_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%r_FW = SrcContStateData%r_FW +ENDIF + END SUBROUTINE FVW_CopyContState + + SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ContStateData%Gamma_NW)) THEN + DEALLOCATE(ContStateData%Gamma_NW) +ENDIF +IF (ALLOCATED(ContStateData%Gamma_FW)) THEN + DEALLOCATE(ContStateData%Gamma_FW) +ENDIF +IF (ALLOCATED(ContStateData%r_NW)) THEN + DEALLOCATE(ContStateData%r_NW) +ENDIF +IF (ALLOCATED(ContStateData%r_FW)) THEN + DEALLOCATE(ContStateData%r_FW) +ENDIF + END SUBROUTINE FVW_DestroyContState + + SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Gamma_NW allocated yes/no + IF ( ALLOCATED(InData%Gamma_NW) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Gamma_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_NW) ! Gamma_NW + END IF + Int_BufSz = Int_BufSz + 1 ! Gamma_FW allocated yes/no + IF ( ALLOCATED(InData%Gamma_FW) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Gamma_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_FW) ! Gamma_FW + END IF + Int_BufSz = Int_BufSz + 1 ! r_NW allocated yes/no + IF ( ALLOCATED(InData%r_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! r_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_NW) ! r_NW + END IF + Int_BufSz = Int_BufSz + 1 ! r_FW allocated yes/no + IF ( ALLOCATED(InData%r_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! r_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_FW) ! r_FW + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%Gamma_NW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Gamma_NW,3), UBOUND(InData%Gamma_NW,3) + DO i2 = LBOUND(InData%Gamma_NW,2), UBOUND(InData%Gamma_NW,2) + DO i1 = LBOUND(InData%Gamma_NW,1), UBOUND(InData%Gamma_NW,1) + ReKiBuf(Re_Xferred) = InData%Gamma_NW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Gamma_FW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Gamma_FW,3), UBOUND(InData%Gamma_FW,3) + DO i2 = LBOUND(InData%Gamma_FW,2), UBOUND(InData%Gamma_FW,2) + DO i1 = LBOUND(InData%Gamma_FW,1), UBOUND(InData%Gamma_FW,1) + ReKiBuf(Re_Xferred) = InData%Gamma_FW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%r_NW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%r_NW,4), UBOUND(InData%r_NW,4) + DO i3 = LBOUND(InData%r_NW,3), UBOUND(InData%r_NW,3) + DO i2 = LBOUND(InData%r_NW,2), UBOUND(InData%r_NW,2) + DO i1 = LBOUND(InData%r_NW,1), UBOUND(InData%r_NW,1) + ReKiBuf(Re_Xferred) = InData%r_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%r_FW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%r_FW,4), UBOUND(InData%r_FW,4) + DO i3 = LBOUND(InData%r_FW,3), UBOUND(InData%r_FW,3) + DO i2 = LBOUND(InData%r_FW,2), UBOUND(InData%r_FW,2) + DO i1 = LBOUND(InData%r_FW,1), UBOUND(InData%r_FW,1) + ReKiBuf(Re_Xferred) = InData%r_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + END SUBROUTINE FVW_PackContState + + SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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 ! Gamma_NW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Gamma_NW)) DEALLOCATE(OutData%Gamma_NW) + ALLOCATE(OutData%Gamma_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Gamma_NW,3), UBOUND(OutData%Gamma_NW,3) + DO i2 = LBOUND(OutData%Gamma_NW,2), UBOUND(OutData%Gamma_NW,2) + DO i1 = LBOUND(OutData%Gamma_NW,1), UBOUND(OutData%Gamma_NW,1) + OutData%Gamma_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_FW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Gamma_FW)) DEALLOCATE(OutData%Gamma_FW) + ALLOCATE(OutData%Gamma_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Gamma_FW,3), UBOUND(OutData%Gamma_FW,3) + DO i2 = LBOUND(OutData%Gamma_FW,2), UBOUND(OutData%Gamma_FW,2) + DO i1 = LBOUND(OutData%Gamma_FW,1), UBOUND(OutData%Gamma_FW,1) + OutData%Gamma_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_NW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%r_NW)) DEALLOCATE(OutData%r_NW) + ALLOCATE(OutData%r_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%r_NW,4), UBOUND(OutData%r_NW,4) + DO i3 = LBOUND(OutData%r_NW,3), UBOUND(OutData%r_NW,3) + DO i2 = LBOUND(OutData%r_NW,2), UBOUND(OutData%r_NW,2) + DO i1 = LBOUND(OutData%r_NW,1), UBOUND(OutData%r_NW,1) + OutData%r_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_FW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%r_FW)) DEALLOCATE(OutData%r_FW) + ALLOCATE(OutData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%r_FW,4), UBOUND(OutData%r_FW,4) + DO i3 = LBOUND(OutData%r_FW,3), UBOUND(OutData%r_FW,3) + DO i2 = LBOUND(OutData%r_FW,2), UBOUND(OutData%r_FW,2) + DO i1 = LBOUND(OutData%r_FW,1), UBOUND(OutData%r_FW,1) + OutData%r_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + END SUBROUTINE FVW_UnPackContState + + SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%NULL = SrcDiscStateData%NULL + CALL UA_CopyDiscState( SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FVW_CopyDiscState + + SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyDiscState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat, ErrMsg ) + END SUBROUTINE FVW_DestroyDiscState + + SUBROUTINE FVW_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! NULL + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype + CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%NULL + Re_Xferred = Re_Xferred + 1 + CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FVW_PackDiscState + + SUBROUTINE FVW_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%NULL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FVW_UnPackDiscState + + SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%residual = SrcConstrStateData%residual +IF (ALLOCATED(SrcConstrStateData%Gamma_LL)) THEN + i1_l = LBOUND(SrcConstrStateData%Gamma_LL,1) + i1_u = UBOUND(SrcConstrStateData%Gamma_LL,1) + i2_l = LBOUND(SrcConstrStateData%Gamma_LL,2) + i2_u = UBOUND(SrcConstrStateData%Gamma_LL,2) + IF (.NOT. ALLOCATED(DstConstrStateData%Gamma_LL)) THEN + ALLOCATE(DstConstrStateData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstConstrStateData%Gamma_LL = SrcConstrStateData%Gamma_LL +ENDIF + END SUBROUTINE FVW_CopyConstrState + + SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyConstrState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ConstrStateData%Gamma_LL)) THEN + DEALLOCATE(ConstrStateData%Gamma_LL) +ENDIF + END SUBROUTINE FVW_DestroyConstrState + + SUBROUTINE FVW_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! residual + Int_BufSz = Int_BufSz + 1 ! Gamma_LL allocated yes/no + IF ( ALLOCATED(InData%Gamma_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Gamma_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%residual + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Gamma_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Gamma_LL,2), UBOUND(InData%Gamma_LL,2) + DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) + ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FVW_PackConstrState + + SUBROUTINE FVW_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%residual = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) + ALLOCATE(OutData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Gamma_LL,2), UBOUND(OutData%Gamma_LL,2) + DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) + OutData%Gamma_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FVW_UnPackConstrState + + SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(FVW_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%NULL = SrcOtherStateData%NULL + CALL UA_CopyOtherState( SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOtherStateData%UA_Flag)) THEN + i1_l = LBOUND(SrcOtherStateData%UA_Flag,1) + i1_u = UBOUND(SrcOtherStateData%UA_Flag,1) + i2_l = LBOUND(SrcOtherStateData%UA_Flag,2) + i2_u = UBOUND(SrcOtherStateData%UA_Flag,2) + IF (.NOT. ALLOCATED(DstOtherStateData%UA_Flag)) THEN + ALLOCATE(DstOtherStateData%UA_Flag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA_Flag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOtherStateData%UA_Flag = SrcOtherStateData%UA_Flag +ENDIF + END SUBROUTINE FVW_CopyOtherState + + SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(FVW_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOtherState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat, ErrMsg ) +IF (ALLOCATED(OtherStateData%UA_Flag)) THEN + DEALLOCATE(OtherStateData%UA_Flag) +ENDIF + END SUBROUTINE FVW_DestroyOtherState + + SUBROUTINE FVW_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! NULL + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype + CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! UA_Flag allocated yes/no + IF ( ALLOCATED(InData%UA_Flag) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! UA_Flag upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%UA_Flag) ! UA_Flag + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%NULL + Int_Xferred = Int_Xferred + 1 + CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%UA_Flag) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_Flag,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_Flag,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_Flag,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_Flag,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%UA_Flag,2), UBOUND(InData%UA_Flag,2) + DO i1 = LBOUND(InData%UA_Flag,1), UBOUND(InData%UA_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FVW_PackOtherState + + SUBROUTINE FVW_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%NULL = 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 UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA_Flag not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UA_Flag)) DEALLOCATE(OutData%UA_Flag) + ALLOCATE(OutData%UA_Flag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_Flag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%UA_Flag,2), UBOUND(OutData%UA_Flag,2) + DO i1 = LBOUND(OutData%UA_Flag,1), UBOUND(OutData%UA_Flag,1) + OutData%UA_Flag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FVW_UnPackOtherState + + SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_InitInputType), INTENT(INOUT) :: SrcInitInputData + TYPE(FVW_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName + DstInitInputData%RootName = SrcInitInputData%RootName +IF (ALLOCATED(SrcInitInputData%WingsMesh)) THEN + i1_l = LBOUND(SrcInitInputData%WingsMesh,1) + i1_u = UBOUND(SrcInitInputData%WingsMesh,1) + IF (.NOT. ALLOCATED(DstInitInputData%WingsMesh)) THEN + ALLOCATE(DstInitInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitInputData%WingsMesh,1), UBOUND(SrcInitInputData%WingsMesh,1) + CALL MeshCopy( SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcInitInputData%AFindx)) THEN + i1_l = LBOUND(SrcInitInputData%AFindx,1) + i1_u = UBOUND(SrcInitInputData%AFindx,1) + i2_l = LBOUND(SrcInitInputData%AFindx,2) + i2_u = UBOUND(SrcInitInputData%AFindx,2) + IF (.NOT. ALLOCATED(DstInitInputData%AFindx)) THEN + ALLOCATE(DstInitInputData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%AFindx = SrcInitInputData%AFindx +ENDIF +IF (ALLOCATED(SrcInitInputData%Chord)) THEN + i1_l = LBOUND(SrcInitInputData%Chord,1) + i1_u = UBOUND(SrcInitInputData%Chord,1) + i2_l = LBOUND(SrcInitInputData%Chord,2) + i2_u = UBOUND(SrcInitInputData%Chord,2) + IF (.NOT. ALLOCATED(DstInitInputData%Chord)) THEN + ALLOCATE(DstInitInputData%Chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Chord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%Chord = SrcInitInputData%Chord +ENDIF +IF (ALLOCATED(SrcInitInputData%RElm)) THEN + i1_l = LBOUND(SrcInitInputData%RElm,1) + i1_u = UBOUND(SrcInitInputData%RElm,1) + IF (.NOT. ALLOCATED(DstInitInputData%RElm)) THEN + ALLOCATE(DstInitInputData%RElm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%RElm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%RElm = SrcInitInputData%RElm +ENDIF +IF (ALLOCATED(SrcInitInputData%zHub)) THEN + i1_l = LBOUND(SrcInitInputData%zHub,1) + i1_u = UBOUND(SrcInitInputData%zHub,1) + IF (.NOT. ALLOCATED(DstInitInputData%zHub)) THEN + ALLOCATE(DstInitInputData%zHub(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%zHub = SrcInitInputData%zHub +ENDIF +IF (ALLOCATED(SrcInitInputData%zLocal)) THEN + i1_l = LBOUND(SrcInitInputData%zLocal,1) + i1_u = UBOUND(SrcInitInputData%zLocal,1) + i2_l = LBOUND(SrcInitInputData%zLocal,2) + i2_u = UBOUND(SrcInitInputData%zLocal,2) + IF (.NOT. ALLOCATED(DstInitInputData%zLocal)) THEN + ALLOCATE(DstInitInputData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%zLocal = SrcInitInputData%zLocal +ENDIF +IF (ALLOCATED(SrcInitInputData%zTip)) THEN + i1_l = LBOUND(SrcInitInputData%zTip,1) + i1_u = UBOUND(SrcInitInputData%zTip,1) + IF (.NOT. ALLOCATED(DstInitInputData%zTip)) THEN + ALLOCATE(DstInitInputData%zTip(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%zTip = SrcInitInputData%zTip +ENDIF +IF (ALLOCATED(SrcInitInputData%rLocal)) THEN + i1_l = LBOUND(SrcInitInputData%rLocal,1) + i1_u = UBOUND(SrcInitInputData%rLocal,1) + i2_l = LBOUND(SrcInitInputData%rLocal,2) + i2_u = UBOUND(SrcInitInputData%rLocal,2) + IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN + ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%rLocal = SrcInitInputData%rLocal +ENDIF + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumBladeNodes = SrcInitInputData%NumBladeNodes + DstInitInputData%DTaero = SrcInitInputData%DTaero + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%a_s = SrcInitInputData%a_s + END SUBROUTINE FVW_CopyInitInput + + SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(FVW_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitInputData%WingsMesh)) THEN +DO i1 = LBOUND(InitInputData%WingsMesh,1), UBOUND(InitInputData%WingsMesh,1) + CALL MeshDestroy( InitInputData%WingsMesh(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InitInputData%WingsMesh) +ENDIF +IF (ALLOCATED(InitInputData%AFindx)) THEN + DEALLOCATE(InitInputData%AFindx) +ENDIF +IF (ALLOCATED(InitInputData%Chord)) THEN + DEALLOCATE(InitInputData%Chord) +ENDIF +IF (ALLOCATED(InitInputData%RElm)) THEN + DEALLOCATE(InitInputData%RElm) +ENDIF +IF (ALLOCATED(InitInputData%zHub)) THEN + DEALLOCATE(InitInputData%zHub) +ENDIF +IF (ALLOCATED(InitInputData%zLocal)) THEN + DEALLOCATE(InitInputData%zLocal) +ENDIF +IF (ALLOCATED(InitInputData%zTip)) THEN + DEALLOCATE(InitInputData%zTip) +ENDIF +IF (ALLOCATED(InitInputData%rLocal)) THEN + DEALLOCATE(InitInputData%rLocal) +ENDIF + END SUBROUTINE FVW_DestroyInitInput + + SUBROUTINE FVW_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%FVWFileName) ! FVWFileName + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no + IF ( ALLOCATED(InData%WingsMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) + Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no + IF ( ALLOCATED(InData%AFindx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx + END IF + Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no + IF ( ALLOCATED(InData%Chord) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Chord upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord + END IF + Int_BufSz = Int_BufSz + 1 ! RElm allocated yes/no + IF ( ALLOCATED(InData%RElm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RElm upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%RElm) ! RElm + END IF + Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no + IF ( ALLOCATED(InData%zHub) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub + END IF + Int_BufSz = Int_BufSz + 1 ! zLocal allocated yes/no + IF ( ALLOCATED(InData%zLocal) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! zLocal upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%zLocal) ! zLocal + END IF + Int_BufSz = Int_BufSz + 1 ! zTip allocated yes/no + IF ( ALLOCATED(InData%zTip) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! zTip upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%zTip) ! zTip + END IF + Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no + IF ( ALLOCATED(InData%rLocal) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal + END IF + Int_BufSz = Int_BufSz + 1 ! NumBlades + Int_BufSz = Int_BufSz + 1 ! NumBladeNodes + Db_BufSz = Db_BufSz + 1 ! DTaero + Re_BufSz = Re_BufSz + 1 ! KinVisc + Int_BufSz = Int_BufSz + 1 ! UAMod + Int_BufSz = Int_BufSz + 1 ! UA_Flag + Int_BufSz = Int_BufSz + 1 ! Flookup + Re_BufSz = Re_BufSz + 1 ! a_s + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%FVWFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%WingsMesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) + CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Chord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Chord,2), UBOUND(InData%Chord,2) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RElm) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RElm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RElm,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RElm,1), UBOUND(InData%RElm,1) + ReKiBuf(Re_Xferred) = InData%RElm(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%zHub) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zHub,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%zLocal) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) + DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) + ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%zTip) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zTip,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) + ReKiBuf(Re_Xferred) = InData%zTip(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBladeNodes + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTaero + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE FVW_PackInitInput + + SUBROUTINE FVW_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%FVWFileName) + OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WingsMesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WingsMesh)) DEALLOCATE(OutData%WingsMesh) + ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AFindx)) DEALLOCATE(OutData%AFindx) + ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Chord)) DEALLOCATE(OutData%Chord) + ALLOCATE(OutData%Chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Chord,2), UBOUND(OutData%Chord,2) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RElm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RElm)) DEALLOCATE(OutData%RElm) + ALLOCATE(OutData%RElm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RElm,1), UBOUND(OutData%RElm,1) + OutData%RElm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%zHub)) DEALLOCATE(OutData%zHub) + ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%zLocal)) DEALLOCATE(OutData%zLocal) + ALLOCATE(OutData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) + DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) + OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%zTip)) DEALLOCATE(OutData%zTip) + ALLOCATE(OutData%zTip(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) + OutData%zTip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rLocal)) DEALLOCATE(OutData%rLocal) + ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DTaero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE FVW_UnPackInitInput + + SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_InputFile), INTENT(IN) :: SrcInputFileData + TYPE(FVW_InputFile), INTENT(INOUT) :: DstInputFileData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInputFile' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputFileData%CirculationMethod = SrcInputFileData%CirculationMethod + DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile + DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter + DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit + DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FreeWake = SrcInputFileData%FreeWake + DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart + DstInputFileData%FullCirculationStart = SrcInputFileData%FullCirculationStart + DstInputFileData%DTfvw = SrcInputFileData%DTfvw + DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar + DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels + DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels + DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree + DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity + DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod + DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc + DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod + DstInputFileData%RegFunction = SrcInputFileData%RegFunction + DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod + DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam + DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam + DstInputFileData%ShearModel = SrcInputFileData%ShearModel + DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake + DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod + DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor + DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment + DstInputFileData%WrVTK = SrcInputFileData%WrVTK + DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades + DstInputFileData%DTvtk = SrcInputFileData%DTvtk + DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord + END SUBROUTINE FVW_CopyInputFile + + SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + TYPE(FVW_InputFile), INTENT(INOUT) :: InputFileData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInputFile' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE FVW_DestroyInputFile + + SUBROUTINE FVW_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_InputFile), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInputFile' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! CirculationMethod + Int_BufSz = Int_BufSz + 1*LEN(InData%CirculationFile) ! CirculationFile + Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter + Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit + Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation + Int_BufSz = Int_BufSz + 1 ! IntMethod + Int_BufSz = Int_BufSz + 1 ! FreeWake + Re_BufSz = Re_BufSz + 1 ! FreeWakeStart + Re_BufSz = Re_BufSz + 1 ! FullCirculationStart + Db_BufSz = Db_BufSz + 1 ! DTfvw + Int_BufSz = Int_BufSz + 1 ! CircSolvPolar + Int_BufSz = Int_BufSz + 1 ! nNWPanels + Int_BufSz = Int_BufSz + 1 ! nFWPanels + Int_BufSz = Int_BufSz + 1 ! nFWPanelsFree + Int_BufSz = Int_BufSz + 1 ! FWShedVorticity + Int_BufSz = Int_BufSz + 1 ! DiffusionMethod + Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc + Int_BufSz = Int_BufSz + 1 ! RegDeterMethod + Int_BufSz = Int_BufSz + 1 ! RegFunction + Int_BufSz = Int_BufSz + 1 ! WakeRegMethod + Re_BufSz = Re_BufSz + 1 ! WakeRegParam + Re_BufSz = Re_BufSz + 1 ! WingRegParam + Int_BufSz = Int_BufSz + 1 ! ShearModel + Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake + Int_BufSz = Int_BufSz + 1 ! VelocityMethod + Re_BufSz = Re_BufSz + 1 ! TreeBranchFactor + Int_BufSz = Int_BufSz + 1 ! PartPerSegment + Int_BufSz = Int_BufSz + 1 ! WrVTK + Int_BufSz = Int_BufSz + 1 ! VTKBlades + Db_BufSz = Db_BufSz + 1 ! DTvtk + Int_BufSz = Int_BufSz + 1 ! VTKCoord + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%CirculationMethod + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%CirculationFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%CirculationFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FreeWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FreeWakeStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FullCirculationStart + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTfvw + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CircSolvPolar + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNWPanels + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFWPanels + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFWPanelsFree + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DiffusionMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RegDeterMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RegFunction + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeRegMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WakeRegParam + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WingRegParam + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ShearModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VelocityMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TreeBranchFactor + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PartPerSegment + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKBlades + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTvtk + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKCoord + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_PackInputFile + + SUBROUTINE FVW_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_InputFile), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInputFile' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%CirculationMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%CirculationFile) + OutData%CirculationFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FreeWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FreeWake) + Int_Xferred = Int_Xferred + 1 + OutData%FreeWakeStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FullCirculationStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTfvw = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%CircSolvPolar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNWPanels = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFWPanels = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFWPanelsFree = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) + Int_Xferred = Int_Xferred + 1 + OutData%DiffusionMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RegDeterMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RegFunction = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakeRegMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakeRegParam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WingRegParam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) + Int_Xferred = Int_Xferred + 1 + OutData%VelocityMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TreeBranchFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PartPerSegment = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DTvtk = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VTKCoord = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_UnPackInputFile + + SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(FVW_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitOutputData%Null = SrcInitOutputData%Null + END SUBROUTINE FVW_CopyInitOutput + + SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(FVW_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE FVW_DestroyInitOutput + + SUBROUTINE FVW_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FVW_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Null + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%Null + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_PackInitOutput + + SUBROUTINE FVW_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FVW_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%Null = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_UnPackInitOutput + + + SUBROUTINE FVW_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(FVW_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL FVW_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL FVW_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE FVW_Input_ExtrapInterp + + + SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) + DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) + b = -(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) + u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated + DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) + DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) + b = -(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) + u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) + b = -(u1%HubPosition(i1) - u2%HubPosition(i1)) + u_out%HubPosition(i1) = u1%HubPosition(i1) + b * ScaleFactor + END DO + END SUBROUTINE FVW_Input_ExtrapInterp1 + + + SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) + DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) + b = (t(3)**2*(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) + t(2)**2*(-u1%V_wind(i1,i2) + u3%V_wind(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%V_wind(i1,i2) + t(3)*u2%V_wind(i1,i2) - t(2)*u3%V_wind(i1,i2) ) * scaleFactor + u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated + DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) + DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) + b = (t(3)**2*(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) + t(2)**2*(-u1%HubOrientation(i1,i2) + u3%HubOrientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%HubOrientation(i1,i2) + t(3)*u2%HubOrientation(i1,i2) - t(2)*u3%HubOrientation(i1,i2) ) * scaleFactor + u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) + b = (t(3)**2*(u1%HubPosition(i1) - u2%HubPosition(i1)) + t(2)**2*(-u1%HubPosition(i1) + u3%HubPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%HubPosition(i1) + t(3)*u2%HubPosition(i1) - t(2)*u3%HubPosition(i1) ) * scaleFactor + u_out%HubPosition(i1) = u1%HubPosition(i1) + b + c * t_out + END DO + END SUBROUTINE FVW_Input_ExtrapInterp2 + + + SUBROUTINE FVW_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(FVW_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL FVW_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL FVW_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE FVW_Output_ExtrapInterp + + + SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ALLOCATED(y_out%Vind) .AND. ALLOCATED(y1%Vind)) THEN + DO i3 = LBOUND(y_out%Vind,3),UBOUND(y_out%Vind,3) + DO i2 = LBOUND(y_out%Vind,2),UBOUND(y_out%Vind,2) + DO i1 = LBOUND(y_out%Vind,1),UBOUND(y_out%Vind,1) + b = -(y1%Vind(i1,i2,i3) - y2%Vind(i1,i2,i3)) + y_out%Vind(i1,i2,i3) = y1%Vind(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cl_KJ) .AND. ALLOCATED(y1%Cl_KJ)) THEN + DO i2 = LBOUND(y_out%Cl_KJ,2),UBOUND(y_out%Cl_KJ,2) + DO i1 = LBOUND(y_out%Cl_KJ,1),UBOUND(y_out%Cl_KJ,1) + b = -(y1%Cl_KJ(i1,i2) - y2%Cl_KJ(i1,i2)) + y_out%Cl_KJ(i1,i2) = y1%Cl_KJ(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated + END SUBROUTINE FVW_Output_ExtrapInterp1 + + + SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ALLOCATED(y_out%Vind) .AND. ALLOCATED(y1%Vind)) THEN + DO i3 = LBOUND(y_out%Vind,3),UBOUND(y_out%Vind,3) + DO i2 = LBOUND(y_out%Vind,2),UBOUND(y_out%Vind,2) + DO i1 = LBOUND(y_out%Vind,1),UBOUND(y_out%Vind,1) + b = (t(3)**2*(y1%Vind(i1,i2,i3) - y2%Vind(i1,i2,i3)) + t(2)**2*(-y1%Vind(i1,i2,i3) + y3%Vind(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%Vind(i1,i2,i3) + t(3)*y2%Vind(i1,i2,i3) - t(2)*y3%Vind(i1,i2,i3) ) * scaleFactor + y_out%Vind(i1,i2,i3) = y1%Vind(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cl_KJ) .AND. ALLOCATED(y1%Cl_KJ)) THEN + DO i2 = LBOUND(y_out%Cl_KJ,2),UBOUND(y_out%Cl_KJ,2) + DO i1 = LBOUND(y_out%Cl_KJ,1),UBOUND(y_out%Cl_KJ,1) + b = (t(3)**2*(y1%Cl_KJ(i1,i2) - y2%Cl_KJ(i1,i2)) + t(2)**2*(-y1%Cl_KJ(i1,i2) + y3%Cl_KJ(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl_KJ(i1,i2) + t(3)*y2%Cl_KJ(i1,i2) - t(2)*y3%Cl_KJ(i1,i2) ) * scaleFactor + y_out%Cl_KJ(i1,i2) = y1%Cl_KJ(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated + END SUBROUTINE FVW_Output_ExtrapInterp2 + +END MODULE FVW_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_VTK.f90 b/modules/aerodyn/src/FVW_VTK.f90 new file mode 100644 index 0000000000..8770d43b83 --- /dev/null +++ b/modules/aerodyn/src/FVW_VTK.f90 @@ -0,0 +1,565 @@ +module FVW_VTK + !use PrecisionMod, only: ReKi + use NWTC_Library, only: ReKi, GetNewUnit + implicit none +! character(8), parameter :: RFMT='F14.5' + !character(8), parameter :: RFMT='E24.15E3' + character(8), parameter :: RFMT='E17.8E3' + character(8), parameter :: IFMT='I7' + + TYPE, PUBLIC :: FVW_VTK_Misc + integer :: vtk_unit + logical :: bFileOpen=.false. + + integer :: nData=0; + integer :: nPoints=0; + + logical :: bBinary = .false. + character(len=255) :: buffer + + ! Reference Frame + real(ReKi),dimension(3,3) :: T_g2b + real(ReKi),dimension(3) :: PO_g + END TYPE FVW_VTK_Misc + + character(1), parameter :: NL = char(10) ! New Line character + + interface vtk_dataset_structured_grid; module procedure & + vtk_dataset_structured_grid_flat, & + vtk_dataset_structured_grid_grid + end interface + + interface vtk_point_data_vector; module procedure & + vtk_point_data_vector_flat, & + vtk_point_data_vector_grid2D,& + vtk_point_data_vector_grid + end interface + interface vtk_point_data_scalar; module procedure & + vtk_point_data_scalar_flat, & + vtk_point_data_scalar_grid2D, & + vtk_point_data_scalar_grid + end interface + interface vtk_cell_data_scalar; module procedure & + vtk_cell_data_scalar_1d,& + vtk_cell_data_scalar_2d + end interface + + public + +contains + + subroutine vtk_misc_init(mvtk) + type(FVW_VTK_Misc),intent(inout) :: mvtk + mvtk%vtk_unit = -1 !< VTK output unit [-] + mvtk%bFileOpen = .false. !< binary file is open [-] + mvtk%bBinary = .false. !< write binary files [-] + mvtk%nData = 0 !< number of data lines [-] + mvtk%nPoints = 0 !< number of points [-] + end subroutine + + !> + subroutine set_vtk_binary_format(bBin,mvtk) + logical, intent(in)::bBin + type(FVW_VTK_Misc),intent(inout) :: mvtk + mvtk%bBinary=bBin + end subroutine + + + !> Save a coordinate transform + ! ALL VTK Will be exported in this coordinate system! + subroutine set_vtk_coordinate_transform(T_g2b_in,PO_g_in,mvtk) + real(ReKi),dimension(3,3), intent(in) :: T_g2b_in + real(ReKi),dimension(3) , intent(in) :: PO_g_in + type(FVW_VTK_Misc),intent(inout) :: mvtk + mvtk%T_g2b=T_g2b_in + mvtk%PO_g=PO_g_in + end subroutine + + logical function vtk_new_ascii_file(filename,label,mvtk) + !use MainIO, only: get_free_unit ,check_io + !use MainIOData, only: bSTOP_ALLOWED + !use FileSystem, only: file_exists + !use Logging, only: log_warning,log_error,log_info + ! + character(len=*),intent(in) :: filename + character(len=*),intent(in) :: label + type(FVW_VTK_Misc),intent(inout) :: mvtk + ! + integer :: iostatvar + logical :: b + + if (.not. mvtk%bFileOpen) then + CALL GetNewUnit( mvtk%vtk_unit ) + if (mvtk%bBinary) then + ! Fortran 2003 stream, otherwise intel fortran ! + !form='UNFORMATTED',access='SEQUENTIAL',action='WRITE',convert='BIG_ENDIAN',recordtype='STREAM',buffered='YES', + !print*,'Not available for this compiler' !COMPAQ-COMPILER + !STOP !COMPAQ-COMPILER + open(unit = mvtk%vtk_unit,file= trim(adjustl(filename)),form='UNFORMATTED',access = 'stream',& !OTHER-COMPILER + action = 'WRITE',convert= 'BIG_ENDIAN',iostat=iostatvar,status='replace') !OTHER-COMPILER + else + open(mvtk%vtk_unit,file=trim(adjustl(filename)),iostat=iostatvar,action="write",status='replace') + endif + if (iostatvar == 0) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'# vtk DataFile Version 3.0'//NL + write(mvtk%vtk_unit)trim(label)//NL + write(mvtk%vtk_unit)'BINARY'//NL + else + write(mvtk%vtk_unit,'(a)') '# vtk DataFile Version 2.0' + write(mvtk%vtk_unit,'(a)') label + write(mvtk%vtk_unit,'(a)') 'ASCII' + write(mvtk%vtk_unit,'(a)') ' ' + endif + + mvtk%bFileOpen=.true. + mvtk%nData=-1; + endif + else + b=.false. + !call log_error('VTK: Cannot open two vtk files at the same time, call vtk_close first') + endif + if (iostatvar ==0) then + vtk_new_ascii_file=.true. + else + vtk_new_ascii_file=.false. + endif + end function + + subroutine vtk_close_file(mvtk) + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + close(mvtk%vtk_unit) + mvtk%bFileOpen=.false. + endif + endsubroutine + + + ! ------------------------------------------------------------------------- + ! --- POLYDATA STUFF + ! ------------------------------------------------------------------------- + subroutine vtk_dataset_polydata(Points,mvtk,bladeFrame) + real(ReKi), dimension(:,:),intent(in) :: Points !< 3 x n + type(FVW_VTK_Misc),intent(inout) :: mvtk + logical, intent(in) :: bladeFrame + integer :: i + if ( mvtk%bFileOpen ) then + mvtk%nPoints=size(Points,2) + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'DATASET POLYDATA'//NL + write(mvtk%buffer,'(A,I0,A)') 'POINTS ', mvtk%nPoints ,' double' + write(mvtk%vtk_unit)trim(mvtk%buffer)//NL + if (bladeFrame) then + do i=1,mvtk%nPoints + write(mvtk%vtk_unit)matmul(mvtk%T_g2b,Points(1:3,i)-mvtk%PO_g) + enddo + else + do i=1,mvtk%nPoints + write(mvtk%vtk_unit)Points(1:3,i) + enddo + endif + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A)') 'DATASET POLYDATA' + write(mvtk%vtk_unit,'(A,I0,A)') 'POINTS ', mvtk%nPoints ,' double' + if (bladeFrame) then + do i=1,mvtk%nPoints + write(mvtk%vtk_unit,'(3'//RFMT//')') matmul(mvtk%T_g2b,Points(1:3,i)-mvtk%PO_g) + enddo + else + do i=1,mvtk%nPoints + write(mvtk%vtk_unit,'(3'//RFMT//')') Points(1:3,i) + enddo + endif + write(mvtk%vtk_unit,*) ' ' + endif + endif + end subroutine + + + subroutine vtk_lines(L,mvtk) + integer, dimension(:,:),intent(in) :: L !< 2 x n + type(FVW_VTK_Misc),intent(inout) :: mvtk + + integer :: i + + if ( mvtk%bFileOpen ) then + mvtk%nData=size(L,2) + if (mvtk%bBinary) then + write(mvtk%buffer,'(A,I0,A,I0)')'LINES ',mvtk%nData,' ',3*mvtk%nData + write(mvtk%vtk_unit)trim(mvtk%buffer)//NL + do i=1,mvtk%nData + write(mvtk%vtk_unit)2,L(1:2,i) + enddo + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,I0,A,I0)')'LINES ',mvtk%nData,' ',3*mvtk%nData + do i=1,mvtk%nData + write(mvtk%vtk_unit,'(3'//IFMT//')') 2, L(1:2,i) + enddo + write(mvtk%vtk_unit,*) ' ' + endif + endif + end subroutine + + subroutine vtk_quad(Q,mvtk) + integer, dimension(:,:),intent(in) :: Q !< 4 x n + type(FVW_VTK_Misc),intent(inout) :: mvtk + integer :: i + if ( mvtk%bFileOpen ) then + mvtk%nData=size(Q,2) + if (mvtk%bBinary) then + write(mvtk%buffer,'(A,I0,A,I0)')'POLYGONS ',mvtk%nData,' ',5*mvtk%nData + write(mvtk%vtk_unit)trim(mvtk%buffer)//NL + do i=1,mvtk%nData + write(mvtk%vtk_unit)4,Q(1:4,i) + enddo + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,I0,A,I0)') 'POLYGONS ', mvtk%nData,' ',5*mvtk%nData + do i=1,mvtk%nData + write(mvtk%vtk_unit,'(5'//IFMT//')') 4, Q(1:4,i) + enddo + write(mvtk%vtk_unit,*) ' ' + endif + endif + end subroutine + + ! ------------------------------------------------------------------------- + ! --- RECTILINEAR + ! ------------------------------------------------------------------------- + subroutine vtk_dataset_rectilinear(v1,v2,v3,mvtk) + real(ReKi), dimension(:),intent(in) :: v1,v2,v3 !< n + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + mvtk%nPoints=size(v1)*size(v2)*size(v3) + if (mvtk%bBinary) then + write(mvtk%vtk_unit) 'DATASET RECTILINEAR_GRID'//NL + write(mvtk%buffer,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', size(v1),' ',size(v2),' ',size(v3) + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%buffer,'(A,I0,A)') 'X_COORDINATES ', size(v1), ' double' + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%vtk_unit)v1 + write(mvtk%vtk_unit)NL + write(mvtk%buffer,'(A,I0,A)') 'Y_COORDINATES ', size(v2), ' double' + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%vtk_unit)v2 + write(mvtk%vtk_unit)NL + write(mvtk%buffer,'(A,I0,A)') 'Z_COORDINATES ', size(v3), ' double' + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%vtk_unit)v3 + !write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A)') 'DATASET RECTILINEAR_GRID' + write(mvtk%vtk_unit,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', size(v1),' ',size(v2),' ',size(v3) + write(mvtk%vtk_unit,'(A,I0,A)') 'X_COORDINATES ', size(v1), ' double' + write(mvtk%vtk_unit,'('//RFMT//')') v1 + write(mvtk%vtk_unit,'(A,I0,A)') 'Y_COORDINATES ', size(v2), ' double' + write(mvtk%vtk_unit,'('//RFMT//')') v2 + write(mvtk%vtk_unit,'(A,I0,A)') 'Z_COORDINATES ', size(v3), ' double' + write(mvtk%vtk_unit,'('//RFMT//')') v3 + write(mvtk%vtk_unit,*) ' ' + endif + endif + end subroutine + + ! ------------------------------------------------------------------------- + ! --- STRUCTURED GRID (Points dumped without for loop since memory is in proper order) + ! ------------------------------------------------------------------------- + !> Subroutine using flat data as input (not in natural order) + subroutine vtk_dataset_structured_grid_flat(D,n1,n2,n3,mvtk) + integer , intent(in) :: n1,n2,n3 + real(ReKi), dimension(:,:),intent(in)::D + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + mvtk%nPoints=n1*n2*n3 + if (mvtk%bBinary) then + write(mvtk%vtk_unit) 'DATASET STRUCTURED_GRID'//NL + write(mvtk%buffer,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', n1,' ',n2,' ',n3 + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%buffer,'(A,I0,A)') 'POINTS ', mvtk%nPoints, ' double' + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A)') 'DATASET STRUCTURED_GRID' + write(mvtk%vtk_unit,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', n1,' ',n2,' ',n3 + write(mvtk%vtk_unit,'(A,I0,A)') 'POINTS ', mvtk%nPoints, ' double' + write(mvtk%vtk_unit,'(3'//RFMT//')')D + write(mvtk%vtk_unit,*) ' ' + endif + endif + end subroutine + + !> Using Grid data 4d as input + subroutine vtk_dataset_structured_grid_grid(D,n1,n2,n3,mvtk) + integer , intent(in) :: n1,n2,n3 + real(ReKi), dimension(:,:,:,:),intent(in)::D + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + mvtk%nPoints=n1*n2*n3 + if (mvtk%bBinary) then + write(mvtk%vtk_unit) 'DATASET STRUCTURED_GRID'//NL + write(mvtk%buffer,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', n1,' ',n2,' ',n3 + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%buffer,'(A,I0,A)') 'POINTS ', mvtk%nPoints, ' double' + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A)') 'DATASET STRUCTURED_GRID' + write(mvtk%vtk_unit,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', n1,' ',n2,' ',n3 + write(mvtk%vtk_unit,'(A,I0,A)') 'POINTS ', mvtk%nPoints, ' double' + write(mvtk%vtk_unit,'(3'//RFMT//')')D + write(mvtk%vtk_unit,*) ' ' + endif + endif + end subroutine + + + + ! ------------------------------------------------------------------------- + ! --- POINT DATA + ! ------------------------------------------------------------------------- + subroutine vtk_point_data_init(mvtk) + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + if(mvtk%bBinary) then + write(mvtk%buffer,'(A,I0)')'POINT_DATA ',mvtk%nPoints + write(mvtk%vtk_unit)trim(mvtk%buffer)//NL + else + write(mvtk%vtk_unit,'(A,I0)') 'POINT_DATA ', mvtk%nPoints + endif + endif + end subroutine + + subroutine vtk_point_data_scalar_flat(D,sname,mvtk) + real(ReKi), dimension(:),intent(in)::D + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'SCALARS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)'LOOKUP_TABLE default'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'SCALARS ', sname, ' double' + write(mvtk%vtk_unit,'(A)') 'LOOKUP_TABLE default' + write(mvtk%vtk_unit,'(1'//RFMT//')')D + endif + endif + end subroutine + + subroutine vtk_point_data_scalar_grid(D,sname,mvtk) + real(ReKi), dimension(:,:,:,:),intent(in)::D + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'SCALARS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)'LOOKUP_TABLE default'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'SCALARS ', sname, ' double' + write(mvtk%vtk_unit,'(A)') 'LOOKUP_TABLE default' + write(mvtk%vtk_unit,'(1'//RFMT//')')D + endif + endif + end subroutine + + subroutine vtk_point_data_scalar_grid2D(D,sname,mvtk) + real(ReKi), dimension(:,:,:),intent(in)::D + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'SCALARS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)'LOOKUP_TABLE default'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'SCALARS ', sname, ' double' + write(mvtk%vtk_unit,'(A)') 'LOOKUP_TABLE default' + write(mvtk%vtk_unit,'(1'//RFMT//')')D + endif + endif + end subroutine + + !> + subroutine vtk_point_data_vector_flat(D,sname,mvtk) + real(ReKi), dimension(:,:),intent(in) :: D !< 3 x n + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'VECTORS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'VECTORS ', sname, ' double' + write(mvtk%vtk_unit,'(3'//RFMT//')')D + endif + endif + end subroutine + !> + subroutine vtk_point_data_vector_grid(D,sname,mvtk) + real(ReKi), dimension(:,:,:,:),intent(in) :: D !< 3 x n + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'VECTORS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'VECTORS ', sname, ' double' + write(mvtk%vtk_unit,'(3'//RFMT//')')D + endif + endif + end subroutine + !> + subroutine vtk_point_data_vector_grid2D(D,sname,mvtk) + real(ReKi), dimension(:,:,:),intent(in) :: D !< + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'VECTORS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'VECTORS ', sname, ' double' + write(mvtk%vtk_unit,'(3'//RFMT//')')D + endif + endif + end subroutine + + + ! ------------------------------------------------------------------------- + ! --- CELL DATA + ! ------------------------------------------------------------------------- + subroutine vtk_cell_data_init(mvtk) + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%buffer,'(A,I0)')'CELL_DATA ',mvtk%nData + write(mvtk%vtk_unit)trim(mvtk%buffer)//NL + else + write(mvtk%vtk_unit,'(A,I0)') 'CELL_DATA ', mvtk%nData + endif + endif + end subroutine + + subroutine vtk_cell_data_scalar_1d(D,sname,mvtk) + real(ReKi), dimension(:),intent(in)::D + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'SCALARS '//trim(sname)//' double 1'//NL + write(mvtk%vtk_unit)'LOOKUP_TABLE default'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,fmt='(A,A,A)') 'SCALARS ', sname, ' double' + write(mvtk%vtk_unit,'(A)') 'LOOKUP_TABLE default' + write(mvtk%vtk_unit,'(1'//RFMT//')')D + endif + endif + end subroutine + + subroutine vtk_cell_data_scalar_2d(D,sname,mvtk) + real(ReKi), dimension(:,:),intent(in)::D + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'SCALARS '//trim(sname)//' double 1'//NL + write(mvtk%vtk_unit)'LOOKUP_TABLE default'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,fmt='(A,A,A)') 'SCALARS ', sname, ' double' + write(mvtk%vtk_unit,'(A)') 'LOOKUP_TABLE default' + write(mvtk%vtk_unit,'(1'//RFMT//')')D + endif + endif + end subroutine + + + subroutine vtk_cell_data_vector(D,sname,mvtk) + real(ReKi), dimension(:,:),intent(in) :: D !< 3 x n + character(len=*),intent(in) ::sname + type(FVW_VTK_Misc),intent(inout) :: mvtk + if ( mvtk%bFileOpen ) then + if (mvtk%bBinary) then + write(mvtk%vtk_unit)'VECTORS '//trim(sname)//' double'//NL + write(mvtk%vtk_unit)D + write(mvtk%vtk_unit)NL + else + write(mvtk%vtk_unit,'(A,A,A)') 'VECTORS ', sname, ' double' + write(mvtk%vtk_unit,'(3'//RFMT//')')D + endif + endif + end subroutine + + ! --------------------------------------------------------------------------------} + ! --- VTK Tools + ! --------------------------------------------------------------------------------{ + !> Exports a Plane From a mesh + subroutine export_plane_grid3d(fname,v1,v2,v3,Values,mvtk) + character(len=*),intent(in) :: fname + real(ReKi),dimension(:), intent(in) :: v1,v2,v3 + real(ReKi),dimension(:,:,:,:), intent(in) :: Values + type(FVW_VTK_Misc),intent(inout) :: mvtk + ! Variables + integer :: nD + + ! Writting + if ( vtk_new_ascii_file(trim(fname),'grid',mvtk)) then + nD=size(Values,1) + call vtk_dataset_rectilinear(v1,v2,v3,mvtk) + ! Output as a structured grid, No need to reorder + call vtk_point_data_init(mvtk) + ! Could be a function of nDim, be careful + if(nD==3) then + call vtk_point_data_vector(Values(1:3,:,:,:),'Velocity',mvtk) ! Label... + endif + + call vtk_close_file(mvtk) + endif ! file opening + end subroutine + + !> Exports a Plane From a mesh + subroutine export_plane_grid2d(fname,v1,v2,v3,Values,mvtk) + character(len=*),intent(in) :: fname + real(ReKi),dimension(:), intent(in) :: v1,v2,v3 + real(ReKi),dimension(:,:,:), intent(in) :: Values + type(FVW_VTK_Misc),intent(inout) :: mvtk + ! Variables + integer :: nD + + ! Writting + if ( vtk_new_ascii_file(trim(fname),'plane',mvtk) ) then + nD=size(Values,1) + call vtk_dataset_rectilinear(v1,v2,v3,mvtk) + ! Output as a structured grid, No need to reorder + call vtk_point_data_init(mvtk) + ! Could be a function of nDim, be careful + if(nD==3) then + call vtk_point_data_vector(Values(1:3,:,:),'Velocity',mvtk) ! Label... + endif + + call vtk_close_file(mvtk) + endif ! file opening + end subroutine +end module FVW_VTK diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 new file mode 100644 index 0000000000..dc97783624 --- /dev/null +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -0,0 +1,892 @@ +module FVW_VortexTools + ! Contains Typical Tools for vortex methods + + ! Should be *independent* of the Framework and any derived type + + ! Only low level functions ! + + use NWTC_LIBRARY + + implicit none + + ! Tree parameters + integer, parameter :: IK1 = selected_int_kind(1) ! to store particle branch number (from 1 to 8) + integer,parameter :: M0 = 1, M1_1=2, M1_2=3, M1_3=4, M2_11=5, M2_21=6, M2_22=7, M2_31=8, M2_32=9, M2_33=10 ! For moment coefficients + integer,parameter :: M0_000 = 1 + integer,parameter :: M1_100 = 2 + integer,parameter :: M1_010 = 3 + integer,parameter :: M1_001 = 4 + + !> + type T_Part + real(ReKi), dimension(:,:), pointer :: P =>null() + real(ReKi), dimension(:,:), pointer :: Alpha =>null() + real(ReKi), dimension(:), pointer :: RegParam =>null() + integer(IntKi) :: RegFunction =-1 + integer(IntKi) :: n =-1 + end type T_Part + + !> The node type is recursive and is used to make a chained-list of nodes for the tree + type T_Node + real(ReKi) :: radius !< Typical dimension of a cell (max of x,y,z extent) + real(ReKi),dimension(3) :: center + real(ReKi),dimension(3,10) :: Moments + integer,dimension(:),pointer :: iPart=>null() !< indexes of particles stored in this node + integer,dimension(:),pointer :: leaves=>null() ! NOTE: leaves are introduced to save memory + type(T_Node),dimension(:), pointer :: branches =>null() + integer :: nPart = -1 ! Number of particles in branches and leaves of this node + end type T_Node + + !> The type tree contains some basic data, a chained-list of nodes, and a pointer to the Particle data that were used + type T_Tree + type(T_Part) :: Part !< Storage for all particles + integer :: iStep =-1 !< Time step at which the tree was built + logical :: bGrown =.false. !< Is the tree build + type(T_Node) :: Root !< Contains the chained-list of nodes + end type T_Tree + + interface cut_tree + module procedure cut_tree_parallel ; ! to switch between parallel and rec easily + end interface + +contains + + subroutine VecToLattice(PointVectors, iDepthStart, LatticeVectors, iHeadP) + real(Reki), dimension(:,:), intent(in ) :: PointVectors !< nVal x n + integer(IntKi), intent(in ) :: iDepthStart !< Start index for depth dimension + real(ReKi), dimension(:,:,:), intent(inout) :: LatticeVectors !< nVal x nSpan x nDepth + integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in PointVectors + integer(IntKi) :: iSpan, iDepth + do iDepth = iDepthStart, size(LatticeVectors,3) + do iSpan = 1, size(LatticeVectors,2) + LatticeVectors(:, iSpan, iDepth) = PointVectors(:, iHeadP) + iHeadP=iHeadP+1 + enddo + enddo + end subroutine + + subroutine LatticeToPoints(LatticePoints, iDepthStart, Points, iHeadP) + real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Points 3 x nSpan x nDepth + integer(IntKi), intent(in ) :: iDepthStart !< Start index for depth dimension + real(ReKi), dimension(:,:), intent(inout) :: Points !< + integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in Points + ! Local + integer(IntKi) :: iSpan, iDepth + ! Points are flattened as follows: (Loop order is important) + ! + ! 3---6 + ! | | + ! 2---5 + ! | | + ! 1---4 + ! + do iDepth = iDepthStart, size(LatticePoints,3) + do iSpan = 1, size(LatticePoints,2) + Points(1:3,iHeadP) = LatticePoints(1:3, iSpan, iDepth) + iHeadP=iHeadP+1 + enddo + enddo + + endsubroutine LatticeToPoints + + subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, bShedVorticity, bShedLastVorticity ) + real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Points 3 x nSpan x nDepth + real(Reki), dimension(:,:), intent(in ) :: LatticeGamma !< GammaPanl nSpan x nDepth + integer(IntKi), intent(in ) :: iDepthStart !< Start index for depth dimension + real(ReKi), dimension(:,:), intent(inout) :: SegPoints !< + integer(IntKi), dimension(:,:), intent(inout) :: SegConnct !< + real(ReKi), dimension(:), intent(inout) :: SegGamma !< + integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in SegPoints + integer(IntKi), intent(inout) :: iHeadC !< Index indicating where to start in SegConnct + logical , intent(in ) :: bShedVorticity !< Shed vorticity is included if true + logical , intent(in ) :: bShedLastVorticity !< Shed the last vorticity segment if true + ! Local + integer(IntKi) :: nSpan, nDepth + integer(IntKi) :: iSpan, iDepth + integer(IntKi) :: iHeadP0, iseg1, iseg2, iseg3 ,iseg4 !< Index indicating where to start in SegPoints + real(ReKi) :: Gamma12 + real(ReKi) :: Gamma41 + + nSpan = size(LatticePoints,2) + nDepth= size(LatticePoints,3) + + + iHeadP0=iHeadP ! Storing + ! --- Flattening LatticePoints into SegPoints array, and increment iHeadP + ! We will need all the points, we flatten the point array + call LatticeToPoints(LatticePoints, iDepthStart, SegPoints, iHeadP) + + ! --- Creating segments + ! Naming convention for point indices and segments of a panel: + ! 2---3 + ! | | + ! 1---4 + ! We go "Panel per panel" , for a given Panel, we create + ! - Segment 1-2 + ! - Segment 1-4 + ! - Segment 4-3 if the last Depth panel + ! - Segment 2-3 if the last Span panel + ! Circulation is defined positive as follows (clockwise): + ! 2->-3 + ! ^ v + ! 1-<-4 + do iDepth = iDepthStart, nDepth-1 + do iSpan = 1, nSpan-1 + iseg1 = iHeadP0 + (iSpan-1) +(iDepth-1-iDepthStart+1)*nSpan ! Point 1 + iseg2 = iHeadP0 + (iSpan ) +(iDepth-1-iDepthStart+1)*nSpan ! Point 2 + iseg3 = iHeadP0 + (iSpan ) +(iDepth -iDepthStart+1)*nSpan ! Point 3 + iseg4 = iHeadP0 + (iSpan-1) +(iDepth -iDepthStart+1)*nSpan ! Point 4 + if (iDepth==iDepthStart) then + Gamma12 = LatticeGamma(iSpan,iDepth) + else + Gamma12 = LatticeGamma(iSpan,iDepth)-LatticeGamma(iSpan,iDepth-1) + endif + if (iSpan==1) then + Gamma41 = LatticeGamma(iSpan,iDepth) + else + Gamma41 = LatticeGamma(iSpan,iDepth)-LatticeGamma(iSpan-1,iDepth) + endif + ! Segment 1-2 + if (bShedVorticity) then + SegConnct(1,iHeadC) = iseg1 + SegConnct(2,iHeadC) = iseg2 + SegConnct(3,iHeadC) = iDepth + SegConnct(4,iHeadC) = iSpan + SegGamma (iHeadC ) = Gamma12 + iHeadC=iHeadC+1 + endif + ! Segment 1-4 + SegConnct(1,iHeadC) = iseg1 + SegConnct(2,iHeadC) = iseg4 + SegConnct(3,iHeadC) = iDepth + SegConnct(4,iHeadC) = iSpan + SegGamma (iHeadC ) = -Gamma41 + iHeadC=iHeadC+1 + ! Segment 4-3 + if (iDepth==nDepth-1) then + if ((bShedVorticity) .and. (bShedLastVorticity)) then + SegConnct(1,iHeadC) = iseg4 + SegConnct(2,iHeadC) = iseg3 + SegConnct(3,iHeadC) = iDepth + SegConnct(4,iHeadC) = iSpan + SegGamma (iHeadC ) = - LatticeGamma(iSpan,iDepth) + iHeadC=iHeadC+1 + endif + endif + ! Segment 2-3 + if (iSpan==nSpan-1) then + SegConnct(1,iHeadC) = iseg2 + SegConnct(2,iHeadC) = iseg3 + SegConnct(3,iHeadC) = iDepth + SegConnct(4,iHeadC) = iSpan + SegGamma (iHeadC ) = LatticeGamma(iSpan,iDepth) + iHeadC=iHeadC+1 + endif + enddo + enddo + end subroutine LatticeToSegments + + !> Convert segments between index iSegStart and iSegEnd to particles. + subroutine SegmentsToPart(SegPoints, SegConnct, SegGamma, SegEpsilon, iSegStart, iSegEnd, nPartPerSeg, PartPoints, PartAlpha, PartEpsilon, iHeadPart) + real(ReKi), dimension(:,:), intent(in ) :: SegPoints !< + integer(IntKi), dimension(:,:), intent(in ) :: SegConnct !< + real(ReKi), dimension(:), intent(in ) :: SegGamma !< + real(ReKi), dimension(:), intent(in ) :: SegEpsilon !< + integer, intent(in ) :: iSegStart !< Index where to start in Seg* vectors + integer, intent(in ) :: iSegEnd !< + integer, intent(in ) :: nPartPerSeg !< Segments will be dividied into nPartPerSeg particles + real(ReKi), dimension(:,:), intent(inout) :: PartPoints !< Particle points (3 x nPart) + real(ReKi), dimension(:,:), intent(inout) :: PartAlpha !< Particle intensities (3 x nPart) + real(ReKi), dimension(:), intent(inout) :: PartEpsilon !< Particle regularization parameter (nPart) + integer, optional, intent(inout) :: iHeadPart !< Index where to start in Part* vectors + real(ReKi), dimension(3) :: P1, P2, DP !< Segment extremities + real(ReKi), dimension(3) :: SegDir !< direction vector + real(ReKi), dimension(3) :: PartInt + real(ReKi) :: PartLen !< Initial "length" of the blob + real(ReKi) :: PartEps !< Regularization of the blob + real(ReKi) :: SegLen + integer(IntKi) :: iPart !< index in particle vectors + integer(IntKi) :: iSeg, iSubPart + if (present(iHeadPart)) then + iPart = iHeadPart + else + iPart = 1 + endif + ! loop on selected segments + do iSeg=iSegStart,iSegEnd + P1 = SegPoints(1:3,SegConnct(1,iSeg)) ! Segment extremities + P2 = SegPoints(1:3,SegConnct(2,iSeg)) + DP = P2-P1 + SegLen = sqrt(DP(1)**2 + DP(2)**2 + DP(3)**2) + SegDir = DP/SegLen ! Unit vector along segment direction + PartInt = DP*SegGamma(iSeg)/nPartPerSeg ! alpha = Gamma.L/n = omega.dV [m^3/s] + PartEps = SegEpsilon(iSeg) ! TODO this might need tuning depending on RegFunction and n_new + PartLen = SegLen/nPartPerSeg + do iSubPart=0,nPartPerSeg-1 + PartPoints(1:3, iPart) = P1(1:3) + (0.5_ReKi+iSubPart)*PartLen*SegDir(1:3) ! ds/2:ds:L + PartAlpha (1:3, iPart) = PartInt(1:3) + PartEpsilon( iPart) = PartEps + iPart = iPart +1 + enddo + enddo + if (present(iHeadPart)) then + iHeadPart=iPart + endif + end subroutine SegmentsToPart + + subroutine print_mean_4d(M, Label) + real(ReKi), dimension(:,:,:,:), intent(in) :: M + character(len=*), intent(in) :: Label + integer(IntKi) :: i, j, k + real(ReKi), dimension(3) :: U + ! + U(1:3)=0 + if ((size(M,4)*size(M,3)*size(M,2) )>0) then + do i=1,size(M,4); do j=1,size(M,3); do k=1,size(M,2); + U(1:3)= U(1:3)+ M(1:3, k, j, i) + enddo; enddo; enddo; + U(1:3)=U(1:3)/ (size(M,4)*size(M,3)*size(M,2)) + endif + print'(A25,3F12.4)',trim(Label),U + end subroutine + + subroutine print_mean_3d(M, Label) + real(ReKi), dimension(:,:,:), intent(in) :: M + character(len=*), intent(in) :: Label + integer(IntKi) :: i, j + real(ReKi), dimension(3) :: U + ! + U(1:3)=0 + if ((size(M,3)*size(M,2))>0) then + do i=1,size(M,3); do j=1,size(M,2) + U(1:3)= U(1:3)+ M(1:3, j, i) + enddo; enddo; + U(1:3)=U(1:3)/ (size(M,3)*size(M,2)) + endif + print'(A24,3F12.4)',trim(Label),U + end subroutine + + !> Perform interpolation from control points to nodes assuming CP are between nodes + subroutine interpextrap_cp2node(xin, yin, xnew, ynew) + real(ReKi), intent(in ) :: xin(:) + real(ReKi), intent(in ) :: yin(:) + real(ReKi), intent(in ) :: xnew(:) + real(ReKi), intent( out) :: ynew(:) + integer(IntKi) :: n + n=size(xin) + call InterpArray(xin, yin, xnew(2:n), ynew(2:n)) + ! Boundaries + if (n>1) then ! If more than 2 panels, use extrapolation + ynew(1) = lin_extrap(xnew(1) , xin(1), yin(1), xin(2) , yin(2)) + ynew(n+1) = lin_extrap(xnew(n+1), xin(n), yin(n), xin(n-1), yin(n-1)) + else ! If one panel, duplicate the unique point on both side + ynew(1) = yin(1) + ynew(n+1) = yin(n) !n=1 + endif + contains + !> Perform linear extrapolation to get value of y(x0), using y(x1) and y(x2) + real(ReKi) function lin_extrap(x0, x1, y1, x2, y2) result(y0) + real(ReKi), intent(in) :: x0, x1, y1, x2, y2 + real(ReKi) :: a + a = (x0-x1)/(x0-x2) + y0 = 1._ReKi/(1._ReKi-a) * (y1-a*y2) + end function lin_extrap + end subroutine interpextrap_cp2node + + ! --------------------------------------------------------------------------------} + ! --- Tree -Grow + ! --------------------------------------------------------------------------------{ + subroutine grow_tree(Tree, PartP, PartAlpha, PartRegFunction, PartRegParam, iStep) + type(T_Tree), intent(inout), target :: Tree !< + real(ReKi), dimension(:,:), intent(in ), target :: PartP !< + real(ReKi), dimension(:,:), intent(in ), target :: PartAlpha !< + integer(IntKi), intent(in ) :: PartRegFunction !< + real(ReKi), dimension(:), intent(in ), target :: PartRegParam !< + integer(IntKi), intent(in ) :: iStep !< + type(T_Node), pointer :: node !< Alias + type(T_Part), pointer :: Part !< Alias + real(ReKi) :: max_x,max_y,max_z !< for domain dimension + real(ReKi) :: min_x,min_y,min_z !< for domain dimension + integer(IntKi) :: i + + ! Cutting tree if it already has content + if (associated(Tree%root%branches).or.associated(Tree%root%leaves)) then + call cut_tree_parallel(Tree) + endif + ! Linking tree particles to given part, no copy! + nullify(Tree%Part%P) + nullify(Tree%Part%Alpha) + nullify(Tree%Part%RegParam) + Tree%Part%P => PartP + Tree%Part%Alpha => PartAlpha + Tree%Part%RegParam => PartRegParam + Tree%Part%RegFunction = PartRegFunction + Tree%Part%n = size(PartP,2) + + ! --- Handle special case for root node + node => Tree%Root + Part => Tree%Part + if (Part%n==0) then + ! Do nothing + node%radius = -9999.99_ReKi + node%center = -9999.99_ReKi + node%Moments= -9999.99_ReKi + else if (Tree%Part%n==1) then + node%radius=0 + node%center(1:3)=Part%P(1:3,1) + node%Moments=0.0_ReKi + nullify(node%iPart) + nullify(node%branches) + allocate(node%leaves(1:1)) + node%leaves(1) = Part%n !< index + node%nPart = 1 + else + ! Domain dimensions + max_x=maxval(Part%P(1,1:Part%n)); max_y=maxval(Part%P(2,1:Part%n)); max_z=maxval(Part%P(3,1:Part%n)) + min_x=minval(Part%P(1,1:Part%n)); min_y=minval(Part%P(2,1:Part%n)); min_z=minval(Part%P(3,1:Part%n)) + + ! Init of trunc + ! Radius taken slightly bigger than domain extent. This radius will be divided by 2 successively + node%radius = max(abs(max_x-min_x),abs(max_y-min_y),abs(max_z-min_z))*1.001_ReKi + if(node%radius>1e6) then + print*,'[Error] Domain extent too large, particle points must be invalid'; + print*, min_x, max_x, min_y, max_y, min_z, max_z + STOP + endif + node%center = (/ (max_x+min_x)/2._ReKi, (max_y+min_y)/2._ReKi, (max_z+min_z)/2._ReKi /) + node%Moments=0.0_ReKi + if(associated(node%iPart)) then ; print*,'[Error] Node part allocated'; STOP; endif + allocate(node%iPart(1:Part%n)) + do i=1,Part%n + node%iPart(i) = i + end do + if(associated(node%branches)) then; print*,'node branches allocated'; STOP; endif + if(associated(node%leaves)) then; print*,'node leaves allocated'; STOP; endif + node%branches=>null() + node%leaves=>null() + node%nPart=Part%n + ! --- Calling grow function on subbrances + call grow_tree_parallel(Tree%root, Tree%Part) +! call grow_tree_rec(Tree%root, Tree%Part) + endif + Tree%iStep = iStep + Tree%bGrown = .true. + end subroutine grow_tree + + !> Recursive function to grow/setup a tree. + !! Note, needed preliminary calc are done by grow_tree before + recursive subroutine grow_tree_rec(node, Part) + type(T_Node), target :: node !< + type(T_Part), intent(in) :: Part !< + integer :: i + ! Sub Step: + ! - compute moments and center for the current node + ! - allocate branches and leaves + call grow_tree_substep(node, Part) + ! Call grow_tree on branches + if(associated(node%branches)) then + do i = 1,size(node%branches) + call grow_tree_rec(node%branches(i), Part) + end do + endif + end subroutine grow_tree_rec + + !> Perform a substep of tree growth, growing sub branches from a given node/cell + !! Parent has already setup node%iPart, indices of the particle in this cell + !! Steps are: + !! - Compute node center (barycenter of vorticity) + !! - Compute node moments + !! - Distribute particles in each 8 octants. Branches are not created for empty octant + !! - Allocate branches and leaves and distribute particles to them + subroutine grow_tree_substep(node, Part) + type(T_Node), intent(inout) :: node !< Current node we are growing from + type(T_Part), intent(in) :: Part !< All particles info + integer(IK1) :: iPartOctant !< Index corresponding to which octant the particle falls into + integer :: nLeaves, nBranches + integer :: iLeaf, iOctant, iBranch + integer :: i1,i2,i3,i4,i5,i6,i7,i8 + integer :: i,j,k + real(ReKi) :: wTot, wLoc ! Total and local vorticity strength + real(ReKi) :: halfSize ! TODO remove me + real(ReKi),dimension(3) :: locCenter, DeltaP,PartPos,PartAlpha + real(ReKi),dimension(3) :: nodeGeomCenter !< Geometric center from division of the domain in powers of 2 + real(ReKi),dimension(3) :: nodeBaryCenter !< Vorticity weighted center + integer(IK1),dimension(:),allocatable :: PartOctant !< Stores the octant (1-8) where each particle belongs + integer,dimension(8) :: npart_per_octant !< Number of particle per octant + integer,dimension(8) :: octant2branches !< Mapping between 8 octants, to index of non empty branch + integer,dimension(8) :: octant2leaves !< Idem for singleton/leaves + real(ReKi) :: max_x,max_y,max_z !< for domain dimension + real(ReKi) :: min_x,min_y,min_z !< for domain dimension + nodeGeomCenter = node%center ! NOTE: we rely on the fact that our parent has set this to the Geometric value + nodeBaryCenter = 0.0_ReKi + wTot = 0.0_ReKi + ! --- Barycenter of vorticity of the node + do i = 1,node%nPart + PartPos = Part%P(:,node%iPart(i)) + PartAlpha = Part%Alpha(:,node%iPart(i)) + wLoc = (PartAlpha(1)**2 + PartAlpha(2)**2 + PartAlpha(3)**2)**0.5_ReKi ! Vorticity norm + nodeBaryCenter = nodeBaryCenter + wLoc*PartPos ! Sum coordinates weighted by vorticity + wTot = wTot + wLoc ! Total vorticity + end do + ! There is no vorticity, we make it a empty node and we exit + if(EqualRealNos(abs(wTot),0.0_ReKi)) then + node%nPart=0 + if (associated(node%iPart)) deallocate(node%iPart) + return ! NOTE: we exit + endif + nodeBaryCenter = nodeBaryCenter/wTot ! barycenter of vorticity + node%center = nodeBaryCenter ! updating + + ! --- Calculation of moments about nodeBaryCenter + do i = 1,node%nPart + PartPos = Part%P (:,node%iPart(i)) + PartAlpha = Part%Alpha(:,node%iPart(i)) + DeltaP = PartPos-nodeBaryCenter + ! Order 0 + node%Moments(1:3,M0_000) = node%Moments(1:3,M0_000) + PartAlpha + ! 1st order + node%Moments(1:3,M1_100) = node%Moments(1:3,M1_100) + PartAlpha*DeltaP(1) ! 100 + node%Moments(1:3,M1_010) = node%Moments(1:3,M1_010) + PartAlpha*DeltaP(2) ! 010 + node%Moments(1:3,M1_001) = node%Moments(1:3,M1_001) + PartAlpha*DeltaP(3) ! 001 + ! 2nd order + do j=1,3 + do k=1,j + node%Moments(1:3,3+j+k+j/3) = node%Moments(1:3,3+j+k+j/3) + PartAlpha*DeltaP(j)*DeltaP(k) + end do + end do + end do + + ! --- Distributing particles to the 8 octants (based on the geometric center!) + allocate (PartOctant(1:node%nPart)) + npart_per_octant(1:8)=0 + do i = 1,node%nPart + PartPos = Part%P(:,node%iPart(i)) + ! index corresponding to which octant the particle falls into + iPartOctant = int(1,IK1) + if (PartPos(1) > nodeGeomCenter(1)) iPartOctant = iPartOctant + int(1,IK1) + if (PartPos(2) > nodeGeomCenter(2)) iPartOctant = iPartOctant + int(2,IK1) + if (PartPos(3) > nodeGeomCenter(3)) iPartOctant = iPartOctant + int(4,IK1) + npart_per_octant(iPartOctant) = npart_per_octant(iPartOctant) + 1 ! Counter of particles per octant + PartOctant(i)=iPartOctant ! Store in which octant particle i is + end do + + ! --- Leaves and branches + ! A node contains a combination of child nodes and leaves (single particles) + ! TODO: introduce a "minimum cell size", (e.g. cell radius is less than the Distance for direct evaluation, then all should be leaves) + nLeaves = 0 + nBranches = 0 + octant2branches = 0 + octant2leaves = 0 + do iOctant = 1,8 + if(npart_per_octant(iOctant)==1) then + nLeaves = nLeaves+1 + octant2leaves(iOctant) = nLeaves + else if(npart_per_octant(iOctant)>1) then + if (npart_per_octant(iOctant)==node%nPart) then + ! All particle falls into the same octant, if they all have the same location, we would divide forever. + ! Quick fix below + max_x=maxval(Part%P(1,node%iPart(:))); max_y=maxval(Part%P(2,node%iPart(:))); max_z=maxval(Part%P(3,node%iPart(:))) + min_x=minval(Part%P(1,node%iPart(:))); min_y=minval(Part%P(2,node%iPart(:))); min_z=minval(Part%P(3,node%iPart(:))) + if (max(abs(max_x-min_x),abs(max_y-min_y),abs(max_z-min_z))< 1.0e-5) then + nLeaves=node%nPart + allocate (node%leaves(1:nLeaves)) + do i = 1,node%nPart + node%leaves(i)=node%iPart(i) + enddo + ! Cleanup and exit! + if (associated(node%iPart)) deallocate(node%iPart) ! Freeing memory + if (allocated(PartOctant)) deallocate(PartOctant) + return + endif + endif + nBranches = nBranches+1 + octant2branches(iOctant) = nBranches + endif + enddo + if (associated(node%branches)) then + print*,'Tree build: error, branches associated' + STOP + endif + if (associated(node%leaves)) then + print*,'Tree build: error, leaves associated' + STOP + end if + + if(nBranches>0) allocate (node%branches(1:nBranches)) + if(nLeaves>0) allocate (node%leaves(1:nLeaves)) + + ! --- Initializing the branches nodes and leaves + halfSize = node%radius/2._ReKi + do iOctant = 1,8 ! there is max 8 octant + iBranch = octant2branches(iOctant) + if (iBranch>0) then ! this node has branches + allocate(node%branches(iBranch)%iPart(1:npart_per_octant(iOctant))) + node%branches(iBranch)%nPart=npart_per_octant(iOctant) + ! NOTE: this is geometric center not barycenter + locCenter = nodeGeomCenter + 0.5*halfSize*(/ (-1)**(iOctant), (-1)**floor(0.5*real(iOctant-1)+1), (-1)**floor(0.25*real(iOctant-1)+1) /) + ! Init of branches + node%branches(iBranch)%radius = halfSize ! + node%branches(iBranch)%center = locCenter ! NOTE: this is the geometric center + node%branches(iBranch)%Moments = 0.0_ReKi ! + node%branches(iBranch)%branches=>null() + node%branches(iBranch)%leaves=>null() + endif + ! other cases are leaves or dead branches + end do + + ! Store indices of the particles the sub-branch contains + i1=0; i2=0; i3=0; i4=0; i5=0; i6=0; i7=0; i8=0; + do i = 1,node%nPart + iBranch = octant2branches(PartOctant(i)) + if(iBranch>0) then + select case(iBranch) + case(1);i1=i1+1; node%branches(1)%iPart(i1) = node%iPart(i) + case(2);i2=i2+1; node%branches(2)%iPart(i2) = node%iPart(i) + case(3);i3=i3+1; node%branches(3)%iPart(i3) = node%iPart(i) + case(4);i4=i4+1; node%branches(4)%iPart(i4) = node%iPart(i) + case(5);i5=i5+1; node%branches(5)%iPart(i5) = node%iPart(i) + case(6);i6=i6+1; node%branches(6)%iPart(i6) = node%iPart(i) + case(7);i7=i7+1; node%branches(7)%iPart(i7) = node%iPart(i) + case(8);i8=i8+1; node%branches(8)%iPart(i8) = node%iPart(i) + end select + else + iLeaf = octant2leaves(PartOctant(i)) + if(iLeaf>0) then + node%leaves(iLeaf)=node%iPart(i) + else + print*,'This particle do not belong to anybody!!',i + STOP + endif + endif + end do + if (associated(node%iPart)) deallocate(node%iPart) ! Freeing memory + if (allocated(PartOctant)) deallocate(PartOctant) + end subroutine grow_tree_substep + + !> Grow a tree in "parallel", since recursive calls cannot be parallized easily, we unroll the different layer calls + !! Note, needed preliminary calc are done by grow_tree before! + subroutine grow_tree_parallel(Root, Part) + type(T_Node), intent(inout) :: Root + type(T_Part), intent(in) :: Part + integer :: i, nBranches + integer :: i1 + integer :: i2 + + ! --- Unrolled version of grow_tree for the first node + ! Sub Step: + ! - compute moments and center for the current node + ! - allocate branches and leaves + call grow_tree_substep(Root, Part) + + if(.not. associated(Root%branches)) then + nBranches=0 + else + nBranches=size(Root%branches) + if (nBranches==0) then + print*,'No branches' ! This should not happen + STOP + else + ! Call "grow_tree" on branches + + !$OMP PARALLEL default(shared) + + ! --- Unrolled version of grow_tree for the second levels + !$OMP do private(i) schedule(runtime) + do i = 1,nBranches ! maximum 8 branches + if(Root%branches(i)%nPart>1) then ! I dont think this test is needed + call grow_tree_substep(Root%branches(i), Part) + endif + end do + !$OMP end do + !$OMP barrier ! we need to be sure that all the branches were built + ! --- Unrolled version of grow_tree for third node levels + !$OMP do private(i,i1,i2) schedule(runtime) + do i = 1,nBranches*8 ! maximum 64 sub branches + i1=(i-1)/8+1; + i2=mod(i-1,8)+1; + if(associated(Root%branches(i1)%branches)) then + if (i2<=size(Root%branches(i1)%branches)) then + call grow_tree_rec(Root%branches(i1)%branches(i2), Part) + endif + endif + enddo + !$OMP end do + !Note: We could add more levels + !$OMP END PARALLEL + endif + endif + end subroutine grow_tree_parallel + + + + ! -------------------------------------------------------------------------------- + ! --- Cut tree + ! -------------------------------------------------------------------------------- + !> Cut a tree and all its subbranches in a recursive manner + recursive subroutine cut_tree_rec(node) + integer :: i + type(T_Node),intent(inout) :: node + call cut_substep(node) + if (associated(node%branches)) then + do i=1,size(node%branches) + call cut_tree_rec(node%branches(i)) + end do + deallocate(node%branches) + node%branches=> null() + end if + end subroutine cut_tree_rec + + !> Perform a substep of tree cutting (used by recursive and parallel calls) + subroutine cut_substep(node) + type(T_Node), intent(inout) :: node + if (associated(node%leaves)) then + deallocate(node%leaves) + end if + if (associated(node%iPart)) then + print*,'The tree particles were not properly cleaned' + STOP + deallocate(node%iPart) + end if + end subroutine cut_substep + + !> Cut a tree and all its sub-branches, unrolled to use parallelization for the first 3 levels + subroutine cut_tree_parallel(Tree) + type(T_Tree), intent(inout) :: Tree + integer :: i,i1,i2,nBranches + ! --- Unlinking particles + nullify(Tree%Part%P) + nullify(Tree%Part%Alpha) + nullify(Tree%Part%RegParam) + ! --- Unrolled version of cut_tree for the first node + call cut_substep(Tree%root) + if(associated(Tree%Root%branches)) then + nBranches=size(Tree%Root%branches) + !$OMP PARALLEL default(shared) + + ! --- Unrolled version for the second levels + !$OMP do private(i) schedule(runtime) + do i = 1,nBranches ! maximum 8 branches + call cut_substep(Tree%Root%branches(i)) + end do + !$OMP end do + !$OMP barrier ! we need to be sure that all the branches were cut + + ! --- Unrolled version for third node levels + !$OMP do private(i,i1,i2) schedule(runtime) + do i = 1,nBranches*8 ! maximum 64 sub branches + i1=(i-1)/8+1; + i2=mod(i-1,8)+1; + if(associated(Tree%Root%branches(i1)%branches)) then + if (i2<=size(Tree%Root%branches(i1)%branches)) then + call cut_tree_rec(Tree%Root%branches(i1)%branches(i2)) + endif + endif + enddo + !$OMP end do + !$OMP END PARALLEL + + ! --- Cleanup second level + do i = 1,nBranches ! maximum 8 branches + if (associated(Tree%root%branches(i)%branches)) then + deallocate(Tree%root%branches(i)%branches) + nullify(Tree%root%branches(i)%branches) + endif + end do + + ! --- Cleanup First level + deallocate(Tree%root%branches) + nullify(Tree%root%branches) + endif + if (associated(Tree%root%branches)) then + print*,'Tree cut: branches are still allocated' + STOP + endif + Tree%iStep=-1 + Tree%root%nPart=-1 + Tree%bGrown=.false. + end subroutine cut_tree_parallel + + subroutine print_tree(Tree) + type(T_Tree) :: Tree + character(len=1024) :: preffix + preffix='root' + print '(A, L1)', trim(preffix)//':partP_assoc = ',associated(Tree%Part%P) + print '(A, L1)', trim(preffix)//':bGrown = ',Tree%bGrown + print '(A, I0)', trim(preffix)//':iStep = ',Tree%iStep + call print_tree_rec(Tree%Root, preffix) + contains + recursive subroutine print_tree_rec(node, preffix) + type(T_Node), target :: node !< + character(len=*), intent(in) :: preffix + integer :: i + ! Test if there are enough particles on the node to build new branchess + ! The case of only one particle should be handled upstream by allocating one leaf to the parent node + print'(A)' ,trim(preffix)//':nPart = '//Num2LStr(node%nPart) + print'(A,3F12.3)',trim(preffix)//':center =',node%center + print'(A,1F12.3)',trim(preffix)//':radius =',node%radius + if(associated(node%leaves)) then + do i = 1,size(node%leaves) + print'(A)',trim(preffix)//':leaf'//trim(Num2LStr(i))//'='//trim(Num2LStr(node%leaves(i))) + end do + endif + if(associated(node%branches)) then + do i = 1,size(node%branches) + call print_tree_rec(node%branches(i), trim(preffix)//':branch'//trim(Num2LStr(i))) + end do + endif + end subroutine print_tree_rec + end subroutine print_tree + + ! -------------------------------------------------------------------------------- + ! --- Velocity computation + ! -------------------------------------------------------------------------------- + subroutine ui_tree(Tree, CPs, ioff, icp_beg, icp_end, BranchFactor, DistanceDirect, Uind, ErrStat, ErrMsg) + use FVW_BiotSavart, only: fourpi_inv, ui_part_nograd_11 + type(T_Tree), target, intent(inout) :: Tree !< + integer, intent(in ) :: ioff !< + integer, intent(in ) :: icp_beg !< + integer, intent(in ) :: icp_end !< + real(ReKi), intent(in ) :: BranchFactor !< + real(ReKi), intent(in ) :: DistanceDirect !< Distance under which direct evaluation should be done no matter what the tree cell size is + real(ReKi), dimension(:,:), intent(in ) :: CPs !< Control Points (3 x nCPs) + real(ReKi), dimension(:,:), intent(inout) :: Uind !< Induced velocity at CPs, with side effects (3 x nCPs) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(ReKi), dimension(3) :: Uind_tmp !< + real(ReKi), dimension(3) :: CP !< Current CP + integer :: icp, nDirect, nQuad + type(T_Part), pointer :: Part ! Alias + Part => Tree%Part + if(.not. associated(Part%P)) then + ErrMsg='Ui Part Tree called but tree particles not associated'; ErrStat=ErrID_Fatal; return + endif + !$OMP PARALLEL DEFAULT(SHARED) + !$OMP DO PRIVATE(icp,CP,Uind_tmp,nDirect,nQuad) schedule(runtime) + do icp=icp_beg,icp_end + CP = CPs(1:3,icp) + Uind_tmp(1:3) = 0.0_ReKi + nDirect =0 + nQuad =0 + call ui_tree_11(Tree%root, CP, Uind_tmp, nDirect, nQuad) !< SIDE EFFECTS + !print*,'Number of direct calls, and quad calls',nDirect, nQuad + Uind(1:3,ioff+icp-icp_beg+1) = Uind(1:3,ioff+icp-icp_beg+1) + Uind_tmp(1:3) + enddo + !$OMP END DO + !$OMP END PARALLEL + contains + !> Velocity at one control point from the entire tree + recursive subroutine ui_tree_11(node, CP, Uind, nDirect, nQuad) + real(ReKi),dimension(3),intent(inout) :: CP, Uind !< Velocity at control point, with side effect + integer, intent(inout) :: nDirect,nQuad + type(T_Node), intent(inout) :: node + real(ReKi) :: distDirect, coeff + real(ReKi),dimension(3) :: DeltaP, phi, Uloc + real(ReKi) :: x,y,z,mx,my,mz,r + integer :: i,j,ieqj + integer :: iPart + if (node%nPart<=0) then + ! We skip the dead leaf + elseif (.not.associated(node%branches)) then + ! Loop on leaves + if(associated(node%leaves)) then + do i =1,size(node%leaves) + iPart=node%leaves(i) + DeltaP = CP(1:3) - Part%P(1:3,iPart) + call ui_part_nograd_11(DeltaP, Part%Alpha(1:3,iPart), Part%RegFunction, Part%RegParam(iPart), Uloc) + nDirect=nDirect+1 + Uind(1:3) = Uind(1:3) + Uloc + enddo + endif + else + distDirect = max(BranchFactor*node%radius, DistanceDirect) ! Under this distance-> Direct eval., Above it -> quadrupole calculation + DeltaP = - node%center + CP(1:3) ! Vector between the control point and the center of the branch + r = sqrt( DeltaP(1)**2 + DeltaP(2)**2 + DeltaP(3)**2) + ! Test if the control point is too close from the branch node so that a direct evaluation is needed + if (r Meshing function. Create a 1D mesh of size `n`, based on a `method` and an input vector `x` + subroutine Meshing(method, x, n, y) + ! Arguments declarations + character(len=*), intent(in) :: method !< String defining the method used + integer(IntKi), intent(in) :: n !< size of vector y + real(ReKi), dimension(:),intent(in) :: x !< input vector of nodes or (/ min, max/) + real(ReKi), dimension(:), intent(out) :: y !< output vector with meshing values + ! Variable declarations + real(ReKi), dimension(:),allocatable :: dx !< + integer::jr + y = 0.0_ReKi + select case (method) ! + case ('middle') ! + allocate(dx(1:n)) + dx=diff(x) ! dx is the width of each panel + y(1:n)=x(1:n)+dx(1:n)/2._ReKi + deallocate(dx) + + case ('fullcosineapprox') ! + ! x is assumed to be of size n+1 + if (n==1) then + y(1)=(x(1)+x(2))/2._ReKi ! middle + return + else + allocate(dx(1:n)) + dx=diff(x) ! dx is the width of each panel + y(1) = x(1)+(dx(1) /(dx(1) +dx(2)))*dx(1) + y(n) = x(n)+(dx(n-1)/(dx(n-1)+dx(n)))*dx(n) + do jr=2,n-1 + y(jr)=x(jr)+0.25_ReKi*(dx(jr-1)/(dx(jr-1)+dx(jr)) + dx(jr)/(dx(jr)+dx(jr+1))+1 )*dx(jr) + end do + deallocate(dx) + endif + end select + + contains + !> Compute: x(2:n)-x(1:n-1) + function diff(d) + real(ReKi),dimension(:),intent(in) ::d + real(ReKi),dimension(size(d)-1) ::diff + integer::i + do i=1,size(d)-1 + diff(i)=d(i+1)-d(i) + enddo + end function + end subroutine Meshing + + + !---------------------------------------------------------------------------------------------------------------------------------- + !> Based on an input mesh, sets the following: + !! - s_LL : Dimensionless spanwise coordinate of LL + !! - s_CP_LL : Dimensionless spanwise coordinate of LL CP + !! - chord_LL : chord on LL + !! - chord_LL_CP: chord on LL cp + subroutine Wings_Panelling_Init(Meshes, p, m, ErrStat, ErrMsg ) + type(MeshType), dimension(:), intent(in ) :: Meshes !< Wings mesh + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local + !integer(IntKi) :: ErrStat2 ! temporary error status of the operation + !character(ErrMsgLen) :: ErrMsg2 ! temporary error message + integer(IntKi) :: iW, iSpan + real(ReKi), dimension(3) :: DP + real(ReKi), dimension(:),allocatable :: s_in !< Dimensionless spanwise coordinate of input + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! --- Meshing + do iW = 1,p%nWings + if (allocated(s_in)) deallocate(s_in) + allocate(s_in(1:Meshes(iW)%nNodes)) + ! --- Computing spanwise coordinate of input mesh normalized from 0 to 1 +!Note: this info also exists in InitInp%zLocal + s_in(:) = -999 + s_in(1) = 0 + do iSpan = 2, Meshes(iW)%nNodes + DP = Meshes(iW)%Position(1:3, iSpan) - Meshes(iW)%Position(1:3, iSpan-1) + s_in(iSpan) = s_in(iSpan-1) + norm2(DP) + enddo + + ! --- Setting up Lifting line variables based on input and a "meshing" method (TODO) + if (Meshes(iW)%nNodes /= p%nSpan+1) then + ! TODO Possibly interpolate based on FVW meshing + ! NOTE: p%chord is copied from the InitInput + ErrMsg ='TODO different discretization InputMesh / vortex code'; ErrStat=ErrID_Fatal; return + endif + do iSpan = 1, p%nSpan+1 + m%s_LL (iSpan, iW) = s_in(iSpan) + m%chord_LL(iSpan, iW) = p%chord(iSpan,iW) + enddo + ! --- Control points spanwise location + ! NOTE: we use the cos approximation of VanGarrel. For equispacing, it returns mid point + ! otherwise, points are slightly closer to panels that are shorter + !call Meshing('middle' , m%s_LL(:,iW), p%nSpan, m%s_CP_LL(:,iW)) + call Meshing('fullcosineapprox' , m%s_LL(:,iW), p%nSpan, m%s_CP_LL(:,iW)) + call InterpArray(m%s_LL(:,iW), m%chord_LL(:,iW), m%s_CP_LL(:,iW), m%chord_CP_LL(:,iW)) + enddo + end subroutine Wings_Panelling_Init + !---------------------------------------------------------------------------------------------------------------------------------- + !> Based on an input mesh, sets the following: + !! - LE : Leading edge points (3 x nSpan+1 x nWings) + !! - TE : Trailing edge points (3 x nSpan+1 x nWings) + !! - CP_LL : Coordinates of LL CP" (3 x nSpan x nWings) + !! - Tang : Unit Tangential vector on LL CP" - + !! - Norm : Unit Normal vector on LL CP " - + !! - Orth : Unit Orthogonal vector on LL CP" - + !! - Vstr_LL : Structural velocity on LL CP" m/s + subroutine Wings_Panelling(Meshes, p, m, ErrStat, ErrMsg ) + type(MeshType), dimension(:), intent(in ) :: Meshes !< Wings mesh + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local + !integer(IntKi) :: ErrStat2 ! temporary error status of the operation + !character(ErrMsgLen) :: ErrMsg2 ! temporary error message + integer(IntKi) ::iSpan , iW + real(ReKi), dimension(3) :: P_ref ! Reference point of Input Mesh (e.g. AeroDynamic Center?) + real(ReKi), dimension(3) :: DP_LE ! Distance between reference point and Leading edge + real(ReKi), dimension(3) :: DP_TE ! Distance between reference point and trailing edge + real(ReKi), dimension(3) :: P1,P2,P3,P4,P5,P7,P8,P6,P9,P10 + real(ReKi), dimension(3) :: DP1, DP2, DP3 + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! --- Position of leading edge (LE) and trailing edge (TE) + ! NOTE, this assumes one to one between InputMesh and FVW Mesh + do iW = 1,p%nWings + do iSpan = 1,p%nSpan+1 + P_ref = Meshes(iW)%Position(1:3, iSpan )+Meshes(iW)%TranslationDisp(1:3, iSpan) + DP_LE(1:3) = 0.0 + DP_LE(1) = -m%chord_LL(iSpan,iW)/4. + DP_TE(1:3) = 0.0 + DP_TE(1) = +3.*m%chord_LL(iSpan,iW)/4. + m%LE(1:3, iSpan, iW) = P_ref + DP_LE(1)*Meshes(iW)%Orientation(2,1:3,iSpan) + m%TE(1:3, iSpan, iW) = P_ref + DP_TE(1)*Meshes(iW)%Orientation(2,1:3,iSpan) + enddo + enddo + ! --- Generic code below to compute normal/tangential vectors of a lifting line panel + ! Notations follow vanGarrel [ECN-C--03-079, Development of a wind turbine aerodynamics simulation module,2003] + ! + ! P4 -P10---P7------ P3 + ! | + ! P8 P6 + ! | + ! P1 -P9----P5------ P2 + ! + do iW = 1,p%nWings + do iSpan = 1,p%nSpan + P1 = m%LE(:,iSpan , iw) + P4 = m%LE(:,iSpan+1, iw) + P3 = m%TE(:,iSpan+1, iw) + P2 = m%TE(:,iSpan , iw) + P8 = (P1+P4)/2 + P6 = (P2+P3)/2 + P5 = (P1+P2)/2 + P7 = (P4+P3)/2 + P9 = 0.75_ReKi*P1+0.25_ReKi*P2 + P10 = 0.75_ReKi*P4+0.25_ReKi*P3 + DP1 = P6-P8 + DP2 = P10-P9 + DP3 = P7-P5 + m%Norm(1:3,iSpan,iW) = cross_product(DP1,DP2) + m%Norm(1:3,iSpan,iW) = m%Norm(1:3,iSpan,iW)/norm2(m%Norm(1:3,iSpan,iW)) + m%Tang(1:3,iSpan,iW) = (DP1)/norm2(DP1) ! tangential unit vector, along chord + ! m%Tscoord(1:3,iSpan) = (DP3)/norm2(DP3) ! tangential unit vector, along span, follows ref line + m%dl (1:3,iSpan,iW) = DP2 + m%Orth(1:3,iSpan,iW) = cross_product(m%Norm(1:3,iSpan,iW),m%Tang(1:3,iSpan,iW)) ! orthogonal vector to N and T + m%Area(iSpan, iW) = norm2(cross_product(DP1,DP3)) + DP3 = P1-P3 + m%diag_LL(iSpan, iW) = norm2(DP3) + end do + enddo +!FIXME: does it make sense to use the position mesh for this info? + ! --- Lifting Line/ Bound Circulation panel + ! For now: goes from 1/4 chord to TE + ! More panelling options may be considered in the future + do iW = 1,p%nWings + do iSpan = 1,p%nSpan+1 + m%r_LL(1:3,iSpan,1,iW)= m%TE(1:3,iSpan,iW)*0.25_ReKi+m%LE(1:3,iSpan,iW)*0.75_ReKi ! 1/4 chord + m%r_LL(1:3,iSpan,2,iW)= m%TE(1:3,iSpan,iW) ! TE + enddo + enddo + + ! --- Position of control points CP_LL + ! For now: placed exactly on the LL panel + ! NOTE: separated from other loops just in case a special discretization is used + do iW = 1,p%nWings + call InterpArray(m%s_LL(:,iW), m%r_LL(1,:,1,iW), m%s_CP_LL(:,iW), m%CP_LL(1,:,iW)) + call InterpArray(m%s_LL(:,iW), m%r_LL(2,:,1,iW), m%s_CP_LL(:,iW), m%CP_LL(2,:,iW)) + call InterpArray(m%s_LL(:,iW), m%r_LL(3,:,1,iW), m%s_CP_LL(:,iW), m%CP_LL(3,:,iW)) + enddo + + ! --- Structural velocity on LL + ! TODO: difference meshes in/LL + do iW = 1,p%nWings + call InterpArray(m%s_LL(:,iW), Meshes(iW)%TranslationVel(1,:) ,m%s_CP_LL(:,iW), m%Vstr_LL(1,:,iW)) + call InterpArray(m%s_LL(:,iW), Meshes(iW)%TranslationVel(2,:) ,m%s_CP_LL(:,iW), m%Vstr_LL(2,:,iW)) + call InterpArray(m%s_LL(:,iW), Meshes(iW)%TranslationVel(3,:) ,m%s_CP_LL(:,iW), m%Vstr_LL(3,:,iW)) + enddo + end subroutine Wings_Panelling + + !---------------------------------------------------------------------------------------------------------------------------------- + !> + subroutine Wings_ComputeCirculation(t, Gamma_LL, Gamma_LL_prev, u, p, x, m, AFInfo, ErrStat, ErrMsg, iLabel) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + real(ReKi), dimension(:,:), intent(inout) :: Gamma_LL !< Circulation on all the lifting lines + real(ReKi), dimension(:,:), intent(in ) :: Gamma_LL_prev !< Previous/Guessed circulation + type(FVW_InputType), intent(in ) :: u !< Parameters + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial 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), intent(in) :: iLabel + ! Local + integer(IntKi) :: iW + real(DbKi) :: s, RealAxis + real(ReKi) :: GammaScale + ErrStat = ErrID_None + ErrMsg = "" + + if (t= 9) then + ! Smooth approximations of the Heavyside function + ! Example 1: 1/2 (1+2/pi arctan(k x) ) x \in ]-infty,+infty [ + ! Example 2: 1/(1+exp(k x) ) x \in ]-infty,+infty [ + ! Example 3: sin(pi/2*s)**2 s \in [0,1] + RealAxis = (1-2*s)/(s*(s-1._DbKi)-1.0e-02_DbKi) ! Scaling from 0-1 to real axis + GammaScale = 1._ReKi- 1._ReKi/(1._ReKi+exp(real(RealAxis,ReKi))) + else + GammaScale = s ! Using a linear scaling + endif + endif + else + GammaScale=1.0_ReKi + endif + + if (p%CirculationMethod==idCircPrescribed) then + do iW = 1, p%nWings !Loop over lifting lines + Gamma_LL(1:p%nSpan,iW) = p%PrescribedCirculation(1:p%nSpan) + enddo + + else if (p%CirculationMethod==idCircPolarData) then + ! --- Solve for circulation using polar data + CALL Wings_ComputeCirculationPolarData(Gamma_LL, Gamma_LL_prev, p, x, m, AFInfo, GammaScale, ErrStat, ErrMsg, iLabel) + + else if (p%CirculationMethod==idCircNoFlowThrough) then + ! --- Solve for circulation using the no-flow through condition + ErrMsg='Circulation method nor implemented'; ErrStat=ErrID_Fatal; return ! should never happen + else + ErrMsg='Circulation method nor implemented'; ErrStat=ErrID_Fatal; return ! should never happen + endif + + ! Scale circulation (for initial transient) + Gamma_LL = Gamma_LL * GammaScale + + + endsubroutine Wings_ComputeCirculation + + !---------------------------------------------------------------------------------------------------------------------------------- + !> + subroutine Wings_ComputeCirculationPolarData(Gamma_LL, Gamma_LL_prev, p, x, m, AFInfo, GammaScale, ErrStat, ErrMsg, iLabel) + real(ReKi), dimension(:,:), intent(inout) :: Gamma_LL !< Circulation on all the lifting lines + real(ReKi), dimension(:,:), intent(in ) :: Gamma_LL_prev !< Previous/Guessed circulation + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + real(ReKi), intent(in ) :: GammaScale !< Scaling factor used at init + 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), intent(in) :: iLabel + ! Local + real(ReKi), dimension(:,:), allocatable :: DGamma !< + real(ReKi), dimension(:,:), allocatable :: GammaLastIter !< + logical :: bConverged !< + integer(IntKi) :: iIter !< iteration step number + real(ReKi) :: MeanGamma + real(ReKi), dimension(:,:,:), allocatable :: Vcst !< Part of the velocity that is constant + real(ReKi), dimension(:,:,:), allocatable :: Vvar !< Part of the velocity that is varies due to the solve + integer(IntKi) :: iW, iSpan, iDepth, iWCP, nCPs + real(ReKi), dimension(3) :: P1, P2, P3, P4 + real(ReKi) :: Gamm + ! Error handling + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + !print*,'Parameters for circulation solv: ',p%CircSolvConvCrit ,p%CircSolvRelaxation ,p%CircSolvMaxIter + + allocate(DGamma (1:p%nSpan,1:p%nWings)) + allocate(GammaLastIter(1:p%nSpan,1:p%nWings)) + + ! --- Last iteration circulation + if (m%FirstCall) then + ! We find a guess by looking simply at the Wind and Elasticity velocity + m%Vtot_ll = m%Vwnd_LL - m%Vstr_ll + call CirculationFromPolarData(GammaLastIter, p, m, AFInfo,ErrStat2,ErrMsg2); if(Failed()) return; + else + ! NOTE: we need to inverse the scaling to speed up the convergence + if (.not. EqualRealNos(GammaScale, 0.0_ReKi)) then + GammaLastIter(1:p%nSpan,1:p%nWings) = Gamma_LL_prev(1:p%nSpan,1:p%nWings) / GammaScale + else + GammaLastIter(1:p%nSpan,1:p%nWings) = Gamma_LL_prev(1:p%nSpan,1:p%nWings) + endif + endif + + if (any(x%r_NW(1,:,1:m%nNW+1,:)<-999)) then + ErrMsg='Wings_ComputeCirculationPolarData: Problem in input NW points'; ErrStat=ErrID_Fatal; return + endif + + + ! --- Setting up Vcst: part of the velocity that is constant withing the iteration loop + ! Vrel_ll_cst = U_u0 - U_body + call AllocAry(Vvar, 3, p%nSpan, p%nWings, 'Vvar', ErrStat2, ErrMsg2); if(Failed()) return; + call AllocAry(Vcst, 3, p%nSpan, p%nWings, 'Vcst', ErrStat2, ErrMsg2); if(Failed()) return; + + ! Set m%Vind_LL Induced velocity from Known wake only (after iNWStart+1) + call LiftingLineInducedVelocities(p, x, iNWStart+1, m, ErrStat2, ErrMsg2); if(Failed()) return; + + Vcst = m%Vind_LL + m%Vwnd_LL - m%Vstr_ll + + if (any(m%Vind_LL(1:3,:,:)<-99)) then + ErrMsg='Wings_ComputeCirculationPolarData: Problem in induced velocity on LL points'; ErrStat=ErrID_Fatal; return + endif + if (any(m%Vwnd_LL(1:3,:,:)<-99)) then + ErrMsg='Wings_ComputeCirculationPolarData: Problem in wind velocity on LL points'; ErrStat=ErrID_Fatal; return + endif + + ! --- Convergence loop until near wake gives induction coherent with circulation + bConverged=.false. + iIter=0 + do while (.not.(bConverged) .and. iIter= AbortErrLev + if (Failed) call CleanUp() + end function Failed + subroutine CleanUp() + if(allocated(DGamma )) deallocate(DGamma ) + if(allocated(GammaLastIter)) deallocate(GammaLastIter) + if(allocated(Vcst)) deallocate(Vcst) + if(allocated(Vvar)) deallocate(Vvar) + end subroutine + end subroutine Wings_ComputeCirculationPolarData + + + !> Compute circulation based on polar data + !! Uses m%Vtot_ll to compute Gamma_ll + subroutine CirculationFromPolarData(Gamma_LL, p, m, AFInfo, ErrStat, ErrMsg) + real(ReKi), dimension(:,:), intent(inout) :: Gamma_LL !< Circulation on all the lifting lines + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial 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 + integer(IntKi) :: iW, iCP !< Index on wings and spanwise control points + real(ReKi), dimension(3) :: N, Tc !< Normal and Tangent vector + real(ReKi), dimension(3) :: Vrel, Vrel_orth, Vjouk, Vjouk_orth + real(ReKi) :: Vrel_orth_norm, Vjouk_orth_norm, Vrel_norm + real(ReKi) :: alpha, Re, Cl, Cd, Cm + type(AFI_OutputType) :: AFI_interp + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + do iW=1,p%nWings + do icp=1,p%nSpan + ! Aliases to shorten notations + N = m%Norm(1:3, icp, iW) + Tc = m%Tang(1:3, icp, iW) + Vrel = m%Vtot_LL(1:3,icp,iW) + ! "Orth": cross sectional plane of the lifting line + Vrel_orth(1:3) = dot_product(Vrel,N)*N + dot_product(Vrel,Tc)*Tc + Vrel_orth_norm = norm2(Vrel_orth(1:3)) + Vjouk(1:3) = cross_product(Vrel,m%dl(1:3,icp,iW)) + Vjouk_orth(1:3) = dot_product(Vjouk,N)*N + dot_product(Vjouk,Tc)*Tc + Vjouk_orth_norm = norm2(Vjouk_orth) + Vrel_norm = norm2(Vrel) + + alpha = atan2(dot_product(Vrel,N) , dot_product(Vrel,Tc) ) ! [rad] + Re = p%Chord(icp,iW) * Vrel_norm / p%KinVisc / 1.0E6 + + !if (p%CircSolvPolar==idPolarAeroDyn) then + ! compute steady Airfoil Coefs ! NOTE: UserProp set to 0.0_ReKi (no idea what it does). Also, note this assumes airfoils at nodes. +!TODO: AFindx is on the nodes, not control points. + call AFI_ComputeAirfoilCoefs( alpha, Re, 0.0_ReKi, AFInfo(p%AFindx(icp,iW)), AFI_interp, ErrStat2, ErrMsg2 ); if(Failed()) return; + Cl = AFI_interp%Cl + Cd = AFI_interp%Cd + Cm = AFI_interp%Cm + ! Simple method: + ! Gamma_LL=(0.5 * Cl * Vrel_orth_norm*chord) + ! VanGarrel's method: + Gamma_LL(icp,iW) =(0.5_ReKi * Cl * Vrel_orth_norm**2*m%Area(icp,iW)/(Vjouk_orth_norm)) + ! Convenient storage + m%alpha_LL(icp, iW) = alpha ! [rad] + m%Vreln_LL(icp, iW) = Vrel_norm + enddo + enddo + contains + logical function Failed() + character(25) :: NodeText + if (ErrStat2 /= ErrID_None) then + NodeText = '(node '//trim(num2lstr(icp))//', blade '//trim(num2lstr(iW))//')' + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CirculationFromPolarData'//trim(NodeText)) + end if + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine CirculationFromPolarData + +end module FVW_Wings diff --git a/modules/aerodyn/src/OutListParameters.xlsx b/modules/aerodyn/src/OutListParameters.xlsx deleted file mode 100644 index 4ad9f419d9..0000000000 Binary files a/modules/aerodyn/src/OutListParameters.xlsx and /dev/null differ diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index 04efb0fb11..0f525800ad 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -29,7 +29,6 @@ module UnsteadyAero implicit none private - type(ProgDesc), parameter :: UA_Ver = ProgDesc( 'UnsteadyAero', '', '' ) public :: UA_Init public :: UA_UpdateDiscOtherState @@ -43,7 +42,7 @@ module UnsteadyAero integer(intki), parameter :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] integer(intki), parameter :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] - integer(intki), parameter :: UA_MinemmaPierce = 3 ! UAMod = 3 [Minemma/Pierce variant (changes in Cc and Cm)] + integer(intki), parameter :: UA_MinnemaPierce = 3 ! UAMod = 3 [Minnema/Pierce variant (changes in Cc and Cm)] real(ReKi), parameter :: Gonzalez_factor = 0.2_ReKi ! this factor, proposed by Gonzalez (for "all" models) is used to modify Cc to account for negative values seen at f=0 (see Eqn 1.40) @@ -422,7 +421,6 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ KC%dalpha0 = KC%alpha_filt_cur - BL_p%alpha0 - ! Compute Kalpha using Eqn 1.7 @@ -493,9 +491,14 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ KC%Cn_q_nc = -1.0_ReKi*KC%T_q * ( KC%Kq_f - KC%Kprime_q ) / M ! Eqn 1.19a KC%Cn_alpha_q_nc = KC%Cn_alpha_nc + KC%Cn_q_nc ! Eqn 1.17 - + +if (p%ShedEffect) then KC%X1 = Get_ExpEqn( KC%ds*beta_M_Sqrd*BL_p%b1, 1.0_ReKi, xd%X1_minus1(i,j), BL_p%A1*(KC%alpha_filt_cur - alpha_filt_minus1), 0.0_ReKi ) ! Eqn 1.15a KC%X2 = Get_ExpEqn( KC%ds*beta_M_Sqrd*BL_p%b2, 1.0_ReKi, xd%X2_minus1(i,j), BL_p%A2*(KC%alpha_filt_cur - alpha_filt_minus1), 0.0_ReKi ) ! Eqn 1.15b +else + KC%X1 = 0.0_ReKi ! u%alpha (and alpha_filt_cur) contains shed vorticity effect already + KC%X2 = 0.0_ReKi ! so that alpha_e = u%alpha-alpha0 directly +endif KC%alpha_e = (KC%alpha_filt_cur - BL_p%alpha0) - KC%X1 - KC%X2 ! Eqn 1.14 @@ -503,9 +506,14 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ if ( p%UAMod == UA_Gonzalez ) then ! Compute X3 and X4 using Eqn 1.16a and then add Cn_q_circ (Eqn 1.16) to the previously computed Cn_alpha_q_circ +if (p%ShedEffect) then KC%X3 = Get_ExpEqn( KC%ds*beta_M_Sqrd*BL_p%b1, 1.0_ReKi, xd%X3_minus1(i,j), BL_p%A1*(KC%q_f_cur - q_f_minus1), 0.0_ReKi ) ! Eqn 1.16a [1] KC%X4 = Get_ExpEqn( KC%ds*beta_M_Sqrd*BL_p%b2, 1.0_ReKi, xd%X4_minus1(i,j), BL_p%A2*(KC%q_f_cur - q_f_minus1), 0.0_ReKi ) ! Eqn 1.16a [2] - +else + KC%X3 = 0.0_ReKi ! Similar to X1 and X2, we assumed that this effect is already included + KC%X4 = 0.0_ReKi +endif + KC%Cn_q_circ = KC%C_nalpha_circ*KC%q_f_cur/2.0 - KC%X3 - KC%X4 ! Eqn 1.16 else ! these aren't used (they are possibly output to UA_OUT file, though) @@ -516,14 +524,14 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ K3prime_q = Get_ExpEqn( BL_p%b5*beta_M_Sqrd*KC%ds, 1.0_ReKi, xd%K3prime_q_minus1(i,j), BL_p%A5*(KC%q_f_cur - q_f_minus1), 0.0_ReKi ) ! Eqn 1.26 KC%Cm_q_circ = -BL_p%C_nalpha*(KC%q_f_cur - K3prime_q)*p%c(i,j)/(16.0_ReKi*beta_M*u%U) ! Eqn 1.25 - + KC%Cn_pot = KC%Cn_alpha_q_circ + KC%Cn_alpha_q_nc ! Eqn 1.20 [2a] k_mq = 7.0_ReKi / (15.0_ReKi*(1.0_ReKi-M) + 1.5_ReKi * BL_p%C_nalpha * BL_p%A5 * BL_p%b5 * beta_M * M**2) ! Eqn 1.29 [2] ! CHECK THAT DENOM ISN'T ZERO! Kprimeprime_q = Get_ExpEqn( real(p%dt,ReKi), k_mq**2*T_I , xd%Kprimeprime_q_minus1(i,j) , KC%Kq_f , Kq_f_minus1 ) ! Eqn 1.29 [3] ! Compute Cm_q_nc - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then KC%Cm_q_nc = -1.0_ReKi * KC%Cn_q_nc / 4.0_ReKi - (KC%k_alpha**2) * T_I * (KC%Kq_f - Kprimeprime_q) / (3.0_ReKi*M) ! Eqn 1.31 else KC%Cm_q_nc = -7.0_ReKi * (k_mq**2) * T_I * (KC%Kq_f - Kprimeprime_q) / (12.0_ReKi*M) ! Eqn 1.29 [1] @@ -644,7 +652,7 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ end if - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then if (OtherState%FirstPass(i,j)) then KC%Dalphaf = 0.0_ReKi else @@ -699,11 +707,11 @@ subroutine UA_SetParameters( dt, InitInp, p, ErrStat, ErrMsg ) ! Calls to : NONE !.............................................................................. - real(DbKi), intent(inout) :: dt ! time step length (s) + real(DbKi), intent(in ) :: dt ! time step length (s) type(UA_InitInputType), intent(inout) :: InitInp ! input data for initialization routine, needs to be inout because there is a copy of some data in InitInp in BEMT_SetParameters() type(UA_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), intent( out) :: ErrStat ! error status of the operation + character(*), intent( out) :: ErrMsg ! error message if ErrStat /= ErrID_None integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_SetParameters' @@ -887,7 +895,7 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & type(UA_OutputType), intent( out) :: y ! Initial system outputs (outputs are not calculated; ! only the output mesh is initialized) type(UA_MiscVarType), intent( out) :: m ! Initial misc/optimization variables - real(DbKi), intent(inout) :: interval ! Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval ! Coupling interval in seconds: the rate that ! (1) BEMT_UpdateStates() is called in loose coupling & ! (2) BEMT_UpdateDiscState() is called in tight coupling. ! Input is the suggested time from the glue code; @@ -916,9 +924,6 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & ! Initialize the NWTC Subroutine Library call NWTC_Init( EchoLibVer=.FALSE. ) - ! Display the module information - call DispNVD( UA_Ver ) - call UA_ValidateInput(InitInp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -953,48 +958,48 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & iOffset = (i-1)*p%NumOuts + (j-1)*p%nNodesPerBlade*p%NumOuts chanPrefix = "B"//trim(num2lstr(j))//"N"//trim(num2lstr(i)) - InitOut%WriteOutputHdr(iOffset+ 1) = 'ALPHA_filt'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 2) = 'VREL'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 3) = 'Cn'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 4) = 'Cc'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 5) = 'Cl'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 6) = 'Cd'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 7) = 'Cm'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 8) = 'Cn_aq_circ'//chanPrefix - InitOut%WriteOutputHdr(iOffset+ 9) = 'Cn_aq_nc'//chanPrefix - InitOut%WriteOutputHdr(iOffset+10) = 'Cn_pot'//chanPrefix - InitOut%WriteOutputHdr(iOffset+11) = 'Dp'//chanPrefix - InitOut%WriteOutputHdr(iOffset+12) = 'Cn_prime'//chanPrefix - InitOut%WriteOutputHdr(iOffset+13) = 'fprime'//chanPrefix - InitOut%WriteOutputHdr(iOffset+14) = 'Df'//chanPrefix - InitOut%WriteOutputHdr(iOffset+15) = 'Cn_v'//chanPrefix - InitOut%WriteOutputHdr(iOffset+16) = 'Tau_V'//chanPrefix - InitOut%WriteOutputHdr(iOffset+17) = 'LESF'//chanPrefix - InitOut%WriteOutputHdr(iOffset+18) = 'TESF'//chanPrefix - InitOut%WriteOutputHdr(iOffset+19) = 'VRTX'//chanPrefix - InitOut%WriteOutputHdr(iOffset+20) = 'C_v'//chanPrefix - InitOut%WriteOutputHdr(iOffset+21) = 'Cm_a_nc'//chanPrefix - InitOut%WriteOutputHdr(iOffset+22) = 'Cm_q_nc'//chanPrefix - InitOut%WriteOutputHdr(iOffset+23) = 'Cm_v'//chanPrefix - InitOut%WriteOutputHdr(iOffset+24) = 'alpha_p_f'//chanPrefix - InitOut%WriteOutputHdr(iOffset+25) = 'Dalphaf'//chanPrefix - InitOut%WriteOutputHdr(iOffset+26) = 'PMC'//chanPrefix - InitOut%WriteOutputHdr(iOffset+27) = 'T_f'//chanPrefix - InitOut%WriteOutputHdr(iOffset+28) = 'T_V'//chanPrefix - InitOut%WriteOutputHdr(iOffset+29) = 'dS'//chanPrefix - InitOut%WriteOutputHdr(iOffset+30) = 'T_alpha'//chanPrefix - InitOut%WriteOutputHdr(iOffset+31) = 'T_q'//chanPrefix - InitOut%WriteOutputHdr(iOffset+32) = 'k_alpha'//chanPrefix - InitOut%WriteOutputHdr(iOffset+33) = 'k_q'//chanPrefix - InitOut%WriteOutputHdr(iOffset+34) = 'alpha_e'//chanPrefix - InitOut%WriteOutputHdr(iOffset+35) = 'X1'//chanPrefix - InitOut%WriteOutputHdr(iOffset+36) = 'X2'//chanPrefix - InitOut%WriteOutputHdr(iOffset+37) = 'cn_q_nc'//chanPrefix - InitOut%WriteOutputHdr(iOffset+38) = 'alpha_f'//chanPrefix - InitOut%WriteOutputHdr(iOffset+39) = 'fprimeprime'//chanPrefix - InitOut%WriteOutputHdr(iOffset+40) = 'sigma1'//chanPrefix - InitOut%WriteOutputHdr(iOffset+41) = 'sigma3'//chanPrefix - InitOut%WriteOutputHdr(iOffset+42) = 'T_sh'//chanPrefix + InitOut%WriteOutputHdr(iOffset+ 1) = trim(chanPrefix)//'ALPHA_filt' + InitOut%WriteOutputHdr(iOffset+ 2) = trim(chanPrefix)//'VREL' + InitOut%WriteOutputHdr(iOffset+ 3) = trim(chanPrefix)//'Cn' + InitOut%WriteOutputHdr(iOffset+ 4) = trim(chanPrefix)//'Cc' + InitOut%WriteOutputHdr(iOffset+ 5) = trim(chanPrefix)//'Cl' + InitOut%WriteOutputHdr(iOffset+ 6) = trim(chanPrefix)//'Cd' + InitOut%WriteOutputHdr(iOffset+ 7) = trim(chanPrefix)//'Cm' + InitOut%WriteOutputHdr(iOffset+ 8) = trim(chanPrefix)//'Cn_aq_circ' + InitOut%WriteOutputHdr(iOffset+ 9) = trim(chanPrefix)//'Cn_aq_nc' + InitOut%WriteOutputHdr(iOffset+10) = trim(chanPrefix)//'Cn_pot' + InitOut%WriteOutputHdr(iOffset+11) = trim(chanPrefix)//'Dp' + InitOut%WriteOutputHdr(iOffset+12) = trim(chanPrefix)//'Cn_prime' + InitOut%WriteOutputHdr(iOffset+13) = trim(chanPrefix)//'fprime' + InitOut%WriteOutputHdr(iOffset+14) = trim(chanPrefix)//'Df' + InitOut%WriteOutputHdr(iOffset+15) = trim(chanPrefix)//'Cn_v' + InitOut%WriteOutputHdr(iOffset+16) = trim(chanPrefix)//'Tau_V' + InitOut%WriteOutputHdr(iOffset+17) = trim(chanPrefix)//'LESF' + InitOut%WriteOutputHdr(iOffset+18) = trim(chanPrefix)//'TESF' + InitOut%WriteOutputHdr(iOffset+19) = trim(chanPrefix)//'VRTX' + InitOut%WriteOutputHdr(iOffset+20) = trim(chanPrefix)//'C_v' + InitOut%WriteOutputHdr(iOffset+21) = trim(chanPrefix)//'Cm_a_nc' + InitOut%WriteOutputHdr(iOffset+22) = trim(chanPrefix)//'Cm_q_nc' + InitOut%WriteOutputHdr(iOffset+23) = trim(chanPrefix)//'Cm_v' + InitOut%WriteOutputHdr(iOffset+24) = trim(chanPrefix)//'alpha_p_f' + InitOut%WriteOutputHdr(iOffset+25) = trim(chanPrefix)//'Dalphaf' + InitOut%WriteOutputHdr(iOffset+26) = trim(chanPrefix)//'PMC' + InitOut%WriteOutputHdr(iOffset+27) = trim(chanPrefix)//'T_f' + InitOut%WriteOutputHdr(iOffset+28) = trim(chanPrefix)//'T_V' + InitOut%WriteOutputHdr(iOffset+29) = trim(chanPrefix)//'dS' + InitOut%WriteOutputHdr(iOffset+30) = trim(chanPrefix)//'T_alpha' + InitOut%WriteOutputHdr(iOffset+31) = trim(chanPrefix)//'T_q' + InitOut%WriteOutputHdr(iOffset+32) = trim(chanPrefix)//'k_alpha' + InitOut%WriteOutputHdr(iOffset+33) = trim(chanPrefix)//'k_q' + InitOut%WriteOutputHdr(iOffset+34) = trim(chanPrefix)//'alpha_e' + InitOut%WriteOutputHdr(iOffset+35) = trim(chanPrefix)//'X1' + InitOut%WriteOutputHdr(iOffset+36) = trim(chanPrefix)//'X2' + InitOut%WriteOutputHdr(iOffset+37) = trim(chanPrefix)//'cn_q_nc' + InitOut%WriteOutputHdr(iOffset+38) = trim(chanPrefix)//'alpha_f' + InitOut%WriteOutputHdr(iOffset+39) = trim(chanPrefix)//'fprimeprime' + InitOut%WriteOutputHdr(iOffset+40) = trim(chanPrefix)//'sigma1' + InitOut%WriteOutputHdr(iOffset+41) = trim(chanPrefix)//'sigma3' + InitOut%WriteOutputHdr(iOffset+42) = trim(chanPrefix)//'T_sh' InitOut%WriteOutputUnt(iOffset+1) ='(deg)' @@ -1063,8 +1068,8 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_MinemmaPierce ) call SetErrStat( ErrID_Fatal, & - "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minemma/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) + if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_MinnemaPierce ) call SetErrStat( ErrID_Fatal, & + "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minnema/Pierce variant).", 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 ) @@ -1629,7 +1634,7 @@ subroutine UA_CalcOutput( u, p, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg end if - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then #ifdef TEST_THEORY y%Cc = Cc_FS + KC%Cn_v*tan(KC%alpha_e)*(1-xd%tau_v(misc%iBladeNode, misc%iBlade)/(BL_p%T_VL)) ! Eqn 1.55 with Eqn. 1.40 #else @@ -1715,7 +1720,7 @@ subroutine UA_CalcOutput( u, p, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg x_cp_hat = BL_p%k0 + BL_p%k1*(1.0_ReKi-KC%fprimeprime) + BL_p%k2*sin(pi*KC%fprimeprime**BL_p%k3) ! Eqn 1.42 Cm_FS = BL_p%Cm0 - KC%Cn_alpha_q_circ*(x_cp_hat - 0.25_ReKi) + Cm_common ! Eqn 1.41 - elseif ( p%UAMod == UA_MinemmaPierce ) then + elseif ( p%UAMod == UA_MinnemaPierce ) then ! Look up Cm using alpha_prime_f alpha_prime_f = KC%alpha_f - KC%Dalphaf ! Eqn 1.43a diff --git a/modules/aerodyn/src/UnsteadyAero_Driver.f90 b/modules/aerodyn/src/UnsteadyAero_Driver.f90 index ce2a4a2e25..3ead18584c 100644 --- a/modules/aerodyn/src/UnsteadyAero_Driver.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Driver.f90 @@ -53,8 +53,8 @@ program UnsteadyAero_Driver type(UA_ParameterType) :: p ! Parameters type(UA_InputType) :: u(NumInp) ! System inputs type(UA_OutputType) :: y ! System outputs - integer(IntKi) :: ErrStat ! Status of error message - character(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat, errStat2 ! Status of error message + character(ErrMsgLen) :: ErrMsg, errMsg2 ! Error message if ErrStat /= ErrID_None integer, parameter :: NumAFfiles = 1 character(1024) :: afNames(NumAFfiles) @@ -82,13 +82,11 @@ program UnsteadyAero_Driver ! Display the copyright notice - CALL DispCopyrightLicense( version ) + CALL DispCopyrightLicense( version%Name ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running - CALL WrScr( ' Running '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) - - + CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) ! Parse the driver file if one was provided, if not, then set driver parameters using hardcoded values diff --git a/modules/aerodyn/src/UnsteadyAero_Registry.txt b/modules/aerodyn/src/UnsteadyAero_Registry.txt index be524e7bd6..f10e9aefbe 100644 --- a/modules/aerodyn/src/UnsteadyAero_Registry.txt +++ b/modules/aerodyn/src/UnsteadyAero_Registry.txt @@ -183,6 +183,7 @@ typedef ^ ^ CHARACTER(2 typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - typedef ^ ^ CHARACTER(1) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the UnsteadyAero outputs" - +typedef ^ ^ Logical ShedEffect - .True. - "Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods)" - # # diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index ffe61ed6b8..86605ad912 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -189,6 +189,7 @@ MODULE UnsteadyAero_Types CHARACTER(20) :: OutSFmt !< Output format for header strings [-] CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile !< File unit for the UnsteadyAero outputs [-] + LOGICAL :: ShedEffect = .True. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] END TYPE UA_ParameterType ! ======================= ! ========= UA_InputType ======= @@ -339,12 +340,12 @@ SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%c) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -358,21 +359,25 @@ SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%c))-1 ) = PACK(InData%c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%c) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) + DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) + ReKiBuf(Re_Xferred) = InData%c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodesPerBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_PackInitInput SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -388,12 +393,6 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -409,12 +408,12 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -431,28 +430,25 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%c)>0) OutData%c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%c) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) + DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) + OutData%c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_UnPackInitInput SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -645,12 +641,12 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -662,12 +658,12 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE UA_PackInitOutput @@ -684,12 +680,6 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -757,19 +747,12 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -784,19 +767,12 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE UA_UnPackInitOutput @@ -987,104 +963,104 @@ SUBROUTINE UA_PackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_prime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_nalpha_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kalpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kq_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_filt_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dalpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q_f_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kprime_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cc_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dalphaf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_FS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_fc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_fm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ds - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_prime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_nalpha_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kalpha_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kq_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_filt_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_e + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dalpha0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q_f_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X4 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kprime_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kprime_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_pot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cc_pot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dalphaf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_FS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_fc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_fm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ds + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackKelvinChainType SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1100,12 +1076,6 @@ SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackKelvinChainType' @@ -1119,104 +1089,104 @@ SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cn_prime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kalpha_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kq_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_filt_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_e = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dalpha0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%q_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%q_f_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X4 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_pot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cc_pot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dalphaf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_FS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_fc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_fm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ds = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cn_prime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_nalpha_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kalpha_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kq_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_filt_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_e = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dalpha0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%q_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%q_f_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X4 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kprime_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kprime_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_pot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cc_pot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dalphaf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_FS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_fc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_fm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ds = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackKelvinChainType SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1310,8 +1280,8 @@ SUBROUTINE UA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackContState SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1327,12 +1297,6 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackContState' @@ -1346,8 +1310,8 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackContState SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2158,8 +2122,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alpha_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alpha_minus1))-1 ) = PACK(InData%alpha_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alpha_minus1) + DO i2 = LBOUND(InData%alpha_minus1,2), UBOUND(InData%alpha_minus1,2) + DO i1 = LBOUND(InData%alpha_minus1,1), UBOUND(InData%alpha_minus1,1) + ReKiBuf(Re_Xferred) = InData%alpha_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%alpha_filt_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2174,8 +2142,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alpha_filt_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alpha_filt_minus1))-1 ) = PACK(InData%alpha_filt_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alpha_filt_minus1) + DO i2 = LBOUND(InData%alpha_filt_minus1,2), UBOUND(InData%alpha_filt_minus1,2) + DO i1 = LBOUND(InData%alpha_filt_minus1,1), UBOUND(InData%alpha_filt_minus1,1) + ReKiBuf(Re_Xferred) = InData%alpha_filt_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2190,8 +2162,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q_minus1))-1 ) = PACK(InData%q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q_minus1) + DO i2 = LBOUND(InData%q_minus1,2), UBOUND(InData%q_minus1,2) + DO i1 = LBOUND(InData%q_minus1,1), UBOUND(InData%q_minus1,1) + ReKiBuf(Re_Xferred) = InData%q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kalpha_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2206,8 +2182,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kalpha_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kalpha_f_minus1))-1 ) = PACK(InData%Kalpha_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kalpha_f_minus1) + DO i2 = LBOUND(InData%Kalpha_f_minus1,2), UBOUND(InData%Kalpha_f_minus1,2) + DO i1 = LBOUND(InData%Kalpha_f_minus1,1), UBOUND(InData%Kalpha_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kalpha_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kq_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2222,8 +2202,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kq_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kq_f_minus1))-1 ) = PACK(InData%Kq_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kq_f_minus1) + DO i2 = LBOUND(InData%Kq_f_minus1,2), UBOUND(InData%Kq_f_minus1,2) + DO i1 = LBOUND(InData%Kq_f_minus1,1), UBOUND(InData%Kq_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kq_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2238,8 +2222,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q_f_minus1))-1 ) = PACK(InData%q_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q_f_minus1) + DO i2 = LBOUND(InData%q_f_minus1,2), UBOUND(InData%q_f_minus1,2) + DO i1 = LBOUND(InData%q_f_minus1,1), UBOUND(InData%q_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%q_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X1_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2254,8 +2242,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X1_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X1_minus1))-1 ) = PACK(InData%X1_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X1_minus1) + DO i2 = LBOUND(InData%X1_minus1,2), UBOUND(InData%X1_minus1,2) + DO i1 = LBOUND(InData%X1_minus1,1), UBOUND(InData%X1_minus1,1) + ReKiBuf(Re_Xferred) = InData%X1_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X2_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2270,8 +2262,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X2_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X2_minus1))-1 ) = PACK(InData%X2_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X2_minus1) + DO i2 = LBOUND(InData%X2_minus1,2), UBOUND(InData%X2_minus1,2) + DO i1 = LBOUND(InData%X2_minus1,1), UBOUND(InData%X2_minus1,1) + ReKiBuf(Re_Xferred) = InData%X2_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X3_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2286,8 +2282,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X3_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X3_minus1))-1 ) = PACK(InData%X3_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X3_minus1) + DO i2 = LBOUND(InData%X3_minus1,2), UBOUND(InData%X3_minus1,2) + DO i1 = LBOUND(InData%X3_minus1,1), UBOUND(InData%X3_minus1,1) + ReKiBuf(Re_Xferred) = InData%X3_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X4_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2302,8 +2302,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X4_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X4_minus1))-1 ) = PACK(InData%X4_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X4_minus1) + DO i2 = LBOUND(InData%X4_minus1,2), UBOUND(InData%X4_minus1,2) + DO i1 = LBOUND(InData%X4_minus1,1), UBOUND(InData%X4_minus1,1) + ReKiBuf(Re_Xferred) = InData%X4_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprime_alpha_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2318,8 +2322,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprime_alpha_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprime_alpha_minus1))-1 ) = PACK(InData%Kprime_alpha_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprime_alpha_minus1) + DO i2 = LBOUND(InData%Kprime_alpha_minus1,2), UBOUND(InData%Kprime_alpha_minus1,2) + DO i1 = LBOUND(InData%Kprime_alpha_minus1,1), UBOUND(InData%Kprime_alpha_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprime_alpha_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2334,8 +2342,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprime_q_minus1))-1 ) = PACK(InData%Kprime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprime_q_minus1) + DO i2 = LBOUND(InData%Kprime_q_minus1,2), UBOUND(InData%Kprime_q_minus1,2) + DO i1 = LBOUND(InData%Kprime_q_minus1,1), UBOUND(InData%Kprime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2350,8 +2362,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprimeprime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprimeprime_q_minus1))-1 ) = PACK(InData%Kprimeprime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprimeprime_q_minus1) + DO i2 = LBOUND(InData%Kprimeprime_q_minus1,2), UBOUND(InData%Kprimeprime_q_minus1,2) + DO i1 = LBOUND(InData%Kprimeprime_q_minus1,1), UBOUND(InData%Kprimeprime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprimeprime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K3prime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2366,8 +2382,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K3prime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K3prime_q_minus1))-1 ) = PACK(InData%K3prime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K3prime_q_minus1) + DO i2 = LBOUND(InData%K3prime_q_minus1,2), UBOUND(InData%K3prime_q_minus1,2) + DO i1 = LBOUND(InData%K3prime_q_minus1,1), UBOUND(InData%K3prime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%K3prime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dp_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2382,8 +2402,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dp_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dp_minus1))-1 ) = PACK(InData%Dp_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dp_minus1) + DO i2 = LBOUND(InData%Dp_minus1,2), UBOUND(InData%Dp_minus1,2) + DO i1 = LBOUND(InData%Dp_minus1,1), UBOUND(InData%Dp_minus1,1) + ReKiBuf(Re_Xferred) = InData%Dp_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_pot_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2398,8 +2422,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_pot_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_pot_minus1))-1 ) = PACK(InData%Cn_pot_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_pot_minus1) + DO i2 = LBOUND(InData%Cn_pot_minus1,2), UBOUND(InData%Cn_pot_minus1,2) + DO i1 = LBOUND(InData%Cn_pot_minus1,1), UBOUND(InData%Cn_pot_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_pot_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2414,8 +2442,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_minus1))-1 ) = PACK(InData%fprimeprime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_minus1) + DO i2 = LBOUND(InData%fprimeprime_minus1,2), UBOUND(InData%fprimeprime_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_minus1,1), UBOUND(InData%fprimeprime_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2430,8 +2462,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_c_minus1))-1 ) = PACK(InData%fprimeprime_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_c_minus1) + DO i2 = LBOUND(InData%fprimeprime_c_minus1,2), UBOUND(InData%fprimeprime_c_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_c_minus1,1), UBOUND(InData%fprimeprime_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2446,8 +2482,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_m_minus1))-1 ) = PACK(InData%fprimeprime_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_m_minus1) + DO i2 = LBOUND(InData%fprimeprime_m_minus1,2), UBOUND(InData%fprimeprime_m_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_m_minus1,1), UBOUND(InData%fprimeprime_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2462,8 +2502,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_minus1))-1 ) = PACK(InData%Df_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_minus1) + DO i2 = LBOUND(InData%Df_minus1,2), UBOUND(InData%Df_minus1,2) + DO i1 = LBOUND(InData%Df_minus1,1), UBOUND(InData%Df_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2478,8 +2522,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_c_minus1))-1 ) = PACK(InData%Df_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_c_minus1) + DO i2 = LBOUND(InData%Df_c_minus1,2), UBOUND(InData%Df_c_minus1,2) + DO i1 = LBOUND(InData%Df_c_minus1,1), UBOUND(InData%Df_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2494,8 +2542,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_m_minus1))-1 ) = PACK(InData%Df_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_m_minus1) + DO i2 = LBOUND(InData%Df_m_minus1,2), UBOUND(InData%Df_m_minus1,2) + DO i1 = LBOUND(InData%Df_m_minus1,1), UBOUND(InData%Df_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dalphaf_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2510,8 +2562,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dalphaf_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dalphaf_minus1))-1 ) = PACK(InData%Dalphaf_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dalphaf_minus1) + DO i2 = LBOUND(InData%Dalphaf_minus1,2), UBOUND(InData%Dalphaf_minus1,2) + DO i1 = LBOUND(InData%Dalphaf_minus1,1), UBOUND(InData%Dalphaf_minus1,1) + ReKiBuf(Re_Xferred) = InData%Dalphaf_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%alphaf_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2526,8 +2582,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alphaf_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alphaf_minus1))-1 ) = PACK(InData%alphaf_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alphaf_minus1) + DO i2 = LBOUND(InData%alphaf_minus1,2), UBOUND(InData%alphaf_minus1,2) + DO i1 = LBOUND(InData%alphaf_minus1,1), UBOUND(InData%alphaf_minus1,1) + ReKiBuf(Re_Xferred) = InData%alphaf_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2542,8 +2602,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_minus1))-1 ) = PACK(InData%fprime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_minus1) + DO i2 = LBOUND(InData%fprime_minus1,2), UBOUND(InData%fprime_minus1,2) + DO i1 = LBOUND(InData%fprime_minus1,1), UBOUND(InData%fprime_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2558,8 +2622,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_c_minus1))-1 ) = PACK(InData%fprime_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_c_minus1) + DO i2 = LBOUND(InData%fprime_c_minus1,2), UBOUND(InData%fprime_c_minus1,2) + DO i1 = LBOUND(InData%fprime_c_minus1,1), UBOUND(InData%fprime_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2574,8 +2642,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_m_minus1))-1 ) = PACK(InData%fprime_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_m_minus1) + DO i2 = LBOUND(InData%fprime_m_minus1,2), UBOUND(InData%fprime_m_minus1,2) + DO i1 = LBOUND(InData%fprime_m_minus1,1), UBOUND(InData%fprime_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tau_V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2590,8 +2662,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tau_V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tau_V))-1 ) = PACK(InData%tau_V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tau_V) + DO i2 = LBOUND(InData%tau_V,2), UBOUND(InData%tau_V,2) + DO i1 = LBOUND(InData%tau_V,1), UBOUND(InData%tau_V,1) + ReKiBuf(Re_Xferred) = InData%tau_V(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tau_V_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2606,8 +2682,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tau_V_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tau_V_minus1))-1 ) = PACK(InData%tau_V_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tau_V_minus1) + DO i2 = LBOUND(InData%tau_V_minus1,2), UBOUND(InData%tau_V_minus1,2) + DO i1 = LBOUND(InData%tau_V_minus1,1), UBOUND(InData%tau_V_minus1,1) + ReKiBuf(Re_Xferred) = InData%tau_V_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_v_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2622,8 +2702,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_v_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_v_minus1))-1 ) = PACK(InData%Cn_v_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_v_minus1) + DO i2 = LBOUND(InData%Cn_v_minus1,2), UBOUND(InData%Cn_v_minus1,2) + DO i1 = LBOUND(InData%Cn_v_minus1,1), UBOUND(InData%Cn_v_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_v_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C_V_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2638,8 +2722,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C_V_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_V_minus1))-1 ) = PACK(InData%C_V_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_V_minus1) + DO i2 = LBOUND(InData%C_V_minus1,2), UBOUND(InData%C_V_minus1,2) + DO i1 = LBOUND(InData%C_V_minus1,1), UBOUND(InData%C_V_minus1,1) + ReKiBuf(Re_Xferred) = InData%C_V_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_prime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2654,8 +2742,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_prime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_prime_minus1))-1 ) = PACK(InData%Cn_prime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_prime_minus1) + DO i2 = LBOUND(InData%Cn_prime_minus1,2), UBOUND(InData%Cn_prime_minus1,2) + DO i1 = LBOUND(InData%Cn_prime_minus1,1), UBOUND(InData%Cn_prime_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_prime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackDiscState @@ -2672,12 +2764,6 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2709,15 +2795,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alpha_minus1)>0) OutData%alpha_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alpha_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alpha_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alpha_minus1,2), UBOUND(OutData%alpha_minus1,2) + DO i1 = LBOUND(OutData%alpha_minus1,1), UBOUND(OutData%alpha_minus1,1) + OutData%alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_filt_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2735,15 +2818,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alpha_filt_minus1)>0) OutData%alpha_filt_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alpha_filt_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alpha_filt_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alpha_filt_minus1,2), UBOUND(OutData%alpha_filt_minus1,2) + DO i1 = LBOUND(OutData%alpha_filt_minus1,1), UBOUND(OutData%alpha_filt_minus1,1) + OutData%alpha_filt_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2761,15 +2841,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q_minus1)>0) OutData%q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q_minus1,2), UBOUND(OutData%q_minus1,2) + DO i1 = LBOUND(OutData%q_minus1,1), UBOUND(OutData%q_minus1,1) + OutData%q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kalpha_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2787,15 +2864,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kalpha_f_minus1)>0) OutData%Kalpha_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kalpha_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kalpha_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kalpha_f_minus1,2), UBOUND(OutData%Kalpha_f_minus1,2) + DO i1 = LBOUND(OutData%Kalpha_f_minus1,1), UBOUND(OutData%Kalpha_f_minus1,1) + OutData%Kalpha_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kq_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2813,15 +2887,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kq_f_minus1)>0) OutData%Kq_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kq_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kq_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kq_f_minus1,2), UBOUND(OutData%Kq_f_minus1,2) + DO i1 = LBOUND(OutData%Kq_f_minus1,1), UBOUND(OutData%Kq_f_minus1,1) + OutData%Kq_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2839,15 +2910,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q_f_minus1)>0) OutData%q_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q_f_minus1,2), UBOUND(OutData%q_f_minus1,2) + DO i1 = LBOUND(OutData%q_f_minus1,1), UBOUND(OutData%q_f_minus1,1) + OutData%q_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X1_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2865,15 +2933,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X1_minus1)>0) OutData%X1_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X1_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X1_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X1_minus1,2), UBOUND(OutData%X1_minus1,2) + DO i1 = LBOUND(OutData%X1_minus1,1), UBOUND(OutData%X1_minus1,1) + OutData%X1_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X2_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2891,15 +2956,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X2_minus1)>0) OutData%X2_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X2_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X2_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X2_minus1,2), UBOUND(OutData%X2_minus1,2) + DO i1 = LBOUND(OutData%X2_minus1,1), UBOUND(OutData%X2_minus1,1) + OutData%X2_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X3_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2917,15 +2979,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X3_minus1)>0) OutData%X3_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X3_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X3_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X3_minus1,2), UBOUND(OutData%X3_minus1,2) + DO i1 = LBOUND(OutData%X3_minus1,1), UBOUND(OutData%X3_minus1,1) + OutData%X3_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X4_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2943,15 +3002,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X4_minus1)>0) OutData%X4_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X4_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X4_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X4_minus1,2), UBOUND(OutData%X4_minus1,2) + DO i1 = LBOUND(OutData%X4_minus1,1), UBOUND(OutData%X4_minus1,1) + OutData%X4_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_alpha_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2969,15 +3025,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprime_alpha_minus1)>0) OutData%Kprime_alpha_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprime_alpha_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprime_alpha_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprime_alpha_minus1,2), UBOUND(OutData%Kprime_alpha_minus1,2) + DO i1 = LBOUND(OutData%Kprime_alpha_minus1,1), UBOUND(OutData%Kprime_alpha_minus1,1) + OutData%Kprime_alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2995,15 +3048,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprime_q_minus1)>0) OutData%Kprime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprime_q_minus1,2), UBOUND(OutData%Kprime_q_minus1,2) + DO i1 = LBOUND(OutData%Kprime_q_minus1,1), UBOUND(OutData%Kprime_q_minus1,1) + OutData%Kprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprimeprime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3021,15 +3071,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprimeprime_q_minus1)>0) OutData%Kprimeprime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprimeprime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprimeprime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprimeprime_q_minus1,2), UBOUND(OutData%Kprimeprime_q_minus1,2) + DO i1 = LBOUND(OutData%Kprimeprime_q_minus1,1), UBOUND(OutData%Kprimeprime_q_minus1,1) + OutData%Kprimeprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K3prime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3047,15 +3094,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K3prime_q_minus1)>0) OutData%K3prime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K3prime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K3prime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K3prime_q_minus1,2), UBOUND(OutData%K3prime_q_minus1,2) + DO i1 = LBOUND(OutData%K3prime_q_minus1,1), UBOUND(OutData%K3prime_q_minus1,1) + OutData%K3prime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3073,15 +3117,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dp_minus1)>0) OutData%Dp_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dp_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dp_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dp_minus1,2), UBOUND(OutData%Dp_minus1,2) + DO i1 = LBOUND(OutData%Dp_minus1,1), UBOUND(OutData%Dp_minus1,1) + OutData%Dp_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_pot_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3099,15 +3140,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_pot_minus1)>0) OutData%Cn_pot_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_pot_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_pot_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_pot_minus1,2), UBOUND(OutData%Cn_pot_minus1,2) + DO i1 = LBOUND(OutData%Cn_pot_minus1,1), UBOUND(OutData%Cn_pot_minus1,1) + OutData%Cn_pot_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3125,15 +3163,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_minus1)>0) OutData%fprimeprime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_minus1,2), UBOUND(OutData%fprimeprime_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_minus1,1), UBOUND(OutData%fprimeprime_minus1,1) + OutData%fprimeprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3151,15 +3186,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_c_minus1)>0) OutData%fprimeprime_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_c_minus1,2), UBOUND(OutData%fprimeprime_c_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_c_minus1,1), UBOUND(OutData%fprimeprime_c_minus1,1) + OutData%fprimeprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3177,15 +3209,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_m_minus1)>0) OutData%fprimeprime_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_m_minus1,2), UBOUND(OutData%fprimeprime_m_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_m_minus1,1), UBOUND(OutData%fprimeprime_m_minus1,1) + OutData%fprimeprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3203,15 +3232,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_minus1)>0) OutData%Df_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_minus1,2), UBOUND(OutData%Df_minus1,2) + DO i1 = LBOUND(OutData%Df_minus1,1), UBOUND(OutData%Df_minus1,1) + OutData%Df_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3229,15 +3255,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_c_minus1)>0) OutData%Df_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_c_minus1,2), UBOUND(OutData%Df_c_minus1,2) + DO i1 = LBOUND(OutData%Df_c_minus1,1), UBOUND(OutData%Df_c_minus1,1) + OutData%Df_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3255,15 +3278,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_m_minus1)>0) OutData%Df_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_m_minus1,2), UBOUND(OutData%Df_m_minus1,2) + DO i1 = LBOUND(OutData%Df_m_minus1,1), UBOUND(OutData%Df_m_minus1,1) + OutData%Df_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dalphaf_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3281,15 +3301,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dalphaf_minus1)>0) OutData%Dalphaf_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dalphaf_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dalphaf_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dalphaf_minus1,2), UBOUND(OutData%Dalphaf_minus1,2) + DO i1 = LBOUND(OutData%Dalphaf_minus1,1), UBOUND(OutData%Dalphaf_minus1,1) + OutData%Dalphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alphaf_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3307,15 +3324,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alphaf_minus1)>0) OutData%alphaf_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alphaf_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alphaf_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alphaf_minus1,2), UBOUND(OutData%alphaf_minus1,2) + DO i1 = LBOUND(OutData%alphaf_minus1,1), UBOUND(OutData%alphaf_minus1,1) + OutData%alphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3333,15 +3347,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_minus1)>0) OutData%fprime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_minus1,2), UBOUND(OutData%fprime_minus1,2) + DO i1 = LBOUND(OutData%fprime_minus1,1), UBOUND(OutData%fprime_minus1,1) + OutData%fprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3370,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_c_minus1)>0) OutData%fprime_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_c_minus1,2), UBOUND(OutData%fprime_c_minus1,2) + DO i1 = LBOUND(OutData%fprime_c_minus1,1), UBOUND(OutData%fprime_c_minus1,1) + OutData%fprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3385,15 +3393,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_m_minus1)>0) OutData%fprime_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_m_minus1,2), UBOUND(OutData%fprime_m_minus1,2) + DO i1 = LBOUND(OutData%fprime_m_minus1,1), UBOUND(OutData%fprime_m_minus1,1) + OutData%fprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V not allocated Int_Xferred = Int_Xferred + 1 @@ -3411,15 +3416,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tau_V)>0) OutData%tau_V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tau_V))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tau_V) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tau_V,2), UBOUND(OutData%tau_V,2) + DO i1 = LBOUND(OutData%tau_V,1), UBOUND(OutData%tau_V,1) + OutData%tau_V(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3437,15 +3439,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tau_V_minus1)>0) OutData%tau_V_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tau_V_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tau_V_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tau_V_minus1,2), UBOUND(OutData%tau_V_minus1,2) + DO i1 = LBOUND(OutData%tau_V_minus1,1), UBOUND(OutData%tau_V_minus1,1) + OutData%tau_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_v_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3463,15 +3462,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_v_minus1)>0) OutData%Cn_v_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_v_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_v_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_v_minus1,2), UBOUND(OutData%Cn_v_minus1,2) + DO i1 = LBOUND(OutData%Cn_v_minus1,1), UBOUND(OutData%Cn_v_minus1,1) + OutData%Cn_v_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_V_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3489,15 +3485,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C_V_minus1)>0) OutData%C_V_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_V_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_V_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C_V_minus1,2), UBOUND(OutData%C_V_minus1,2) + DO i1 = LBOUND(OutData%C_V_minus1,1), UBOUND(OutData%C_V_minus1,1) + OutData%C_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_prime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3515,15 +3508,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_prime_minus1)>0) OutData%Cn_prime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_prime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_prime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_prime_minus1,2), UBOUND(OutData%Cn_prime_minus1,2) + DO i1 = LBOUND(OutData%Cn_prime_minus1,1), UBOUND(OutData%Cn_prime_minus1,1) + OutData%Cn_prime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackDiscState @@ -3618,8 +3608,8 @@ SUBROUTINE UA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstraintState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstraintState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackConstrState SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3635,12 +3625,6 @@ SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackConstrState' @@ -3654,8 +3638,8 @@ SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstraintState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstraintState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackConstrState SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3872,8 +3856,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstPass)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%FirstPass)-1 ) = TRANSFER(PACK( InData%FirstPass ,.TRUE.), IntKiBuf(1), SIZE(InData%FirstPass)) - Int_Xferred = Int_Xferred + SIZE(InData%FirstPass) + DO i2 = LBOUND(InData%FirstPass,2), UBOUND(InData%FirstPass,2) + DO i1 = LBOUND(InData%FirstPass,1), UBOUND(InData%FirstPass,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPass(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3888,8 +3876,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1))-1 ) = PACK(InData%sigma1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1) + DO i2 = LBOUND(InData%sigma1,2), UBOUND(InData%sigma1,2) + DO i1 = LBOUND(InData%sigma1,1), UBOUND(InData%sigma1,1) + ReKiBuf(Re_Xferred) = InData%sigma1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1c) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3904,8 +3896,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1c))-1 ) = PACK(InData%sigma1c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1c) + DO i2 = LBOUND(InData%sigma1c,2), UBOUND(InData%sigma1c,2) + DO i1 = LBOUND(InData%sigma1c,1), UBOUND(InData%sigma1c,1) + ReKiBuf(Re_Xferred) = InData%sigma1c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1m) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3920,8 +3916,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1m)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1m))-1 ) = PACK(InData%sigma1m,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1m) + DO i2 = LBOUND(InData%sigma1m,2), UBOUND(InData%sigma1m,2) + DO i1 = LBOUND(InData%sigma1m,1), UBOUND(InData%sigma1m,1) + ReKiBuf(Re_Xferred) = InData%sigma1m(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3936,8 +3936,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma3)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma3))-1 ) = PACK(InData%sigma3,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma3) + DO i2 = LBOUND(InData%sigma3,2), UBOUND(InData%sigma3,2) + DO i1 = LBOUND(InData%sigma3,1), UBOUND(InData%sigma3,1) + ReKiBuf(Re_Xferred) = InData%sigma3(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackOtherState @@ -3954,12 +3958,6 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3991,15 +3989,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FirstPass)>0) OutData%FirstPass = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FirstPass))-1 ), OutData%FirstPass), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%FirstPass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FirstPass,2), UBOUND(OutData%FirstPass,2) + DO i1 = LBOUND(OutData%FirstPass,1), UBOUND(OutData%FirstPass,1) + OutData%FirstPass(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPass(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4017,15 +4012,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1)>0) OutData%sigma1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1,2), UBOUND(OutData%sigma1,2) + DO i1 = LBOUND(OutData%sigma1,1), UBOUND(OutData%sigma1,1) + OutData%sigma1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1c not allocated Int_Xferred = Int_Xferred + 1 @@ -4043,15 +4035,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1c)>0) OutData%sigma1c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1c) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1c,2), UBOUND(OutData%sigma1c,2) + DO i1 = LBOUND(OutData%sigma1c,1), UBOUND(OutData%sigma1c,1) + OutData%sigma1c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1m not allocated Int_Xferred = Int_Xferred + 1 @@ -4069,15 +4058,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1m)>0) OutData%sigma1m = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1m))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1m) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1m,2), UBOUND(OutData%sigma1m,2) + DO i1 = LBOUND(OutData%sigma1m,1), UBOUND(OutData%sigma1m,1) + OutData%sigma1m(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma3 not allocated Int_Xferred = Int_Xferred + 1 @@ -4095,15 +4081,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma3)>0) OutData%sigma3 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma3))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma3,2), UBOUND(OutData%sigma3,2) + DO i1 = LBOUND(OutData%sigma3,1), UBOUND(OutData%sigma3,1) + OutData%sigma3(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackOtherState @@ -4314,12 +4297,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_M , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iBladeNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iBlade - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_M, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iBladeNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iBlade + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TESF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4333,8 +4316,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TESF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%TESF)-1 ) = TRANSFER(PACK( InData%TESF ,.TRUE.), IntKiBuf(1), SIZE(InData%TESF)) - Int_Xferred = Int_Xferred + SIZE(InData%TESF) + DO i2 = LBOUND(InData%TESF,2), UBOUND(InData%TESF,2) + DO i1 = LBOUND(InData%TESF,1), UBOUND(InData%TESF,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%TESF(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LESF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4349,8 +4336,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LESF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%LESF)-1 ) = TRANSFER(PACK( InData%LESF ,.TRUE.), IntKiBuf(1), SIZE(InData%LESF)) - Int_Xferred = Int_Xferred + SIZE(InData%LESF) + DO i2 = LBOUND(InData%LESF,2), UBOUND(InData%LESF,2) + DO i1 = LBOUND(InData%LESF,1), UBOUND(InData%LESF,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%LESF(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%VRTX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4365,8 +4356,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VRTX)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%VRTX)-1 ) = TRANSFER(PACK( InData%VRTX ,.TRUE.), IntKiBuf(1), SIZE(InData%VRTX)) - Int_Xferred = Int_Xferred + SIZE(InData%VRTX) + DO i2 = LBOUND(InData%VRTX,2), UBOUND(InData%VRTX,2) + DO i1 = LBOUND(InData%VRTX,1), UBOUND(InData%VRTX,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%VRTX(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%T_Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4381,8 +4376,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%T_Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%T_Sh))-1 ) = PACK(InData%T_Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%T_Sh) + DO i2 = LBOUND(InData%T_Sh,2), UBOUND(InData%T_Sh,2) + DO i1 = LBOUND(InData%T_Sh,1), UBOUND(InData%T_Sh,1) + ReKiBuf(Re_Xferred) = InData%T_Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4397,8 +4396,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BEDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BEDSEP)-1 ) = TRANSFER(PACK( InData%BEDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%BEDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%BEDSEP) + DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) + DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackMisc @@ -4415,12 +4418,6 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4436,12 +4433,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_M = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%iBladeNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%iBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_M = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_M) + Int_Xferred = Int_Xferred + 1 + OutData%iBladeNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TESF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4458,15 +4455,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TESF)>0) OutData%TESF = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TESF))-1 ), OutData%TESF), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%TESF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TESF,2), UBOUND(OutData%TESF,2) + DO i1 = LBOUND(OutData%TESF,1), UBOUND(OutData%TESF,1) + OutData%TESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%TESF(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LESF not allocated Int_Xferred = Int_Xferred + 1 @@ -4484,15 +4478,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LESF)>0) OutData%LESF = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LESF))-1 ), OutData%LESF), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%LESF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LESF,2), UBOUND(OutData%LESF,2) + DO i1 = LBOUND(OutData%LESF,1), UBOUND(OutData%LESF,1) + OutData%LESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%LESF(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRTX not allocated Int_Xferred = Int_Xferred + 1 @@ -4510,15 +4501,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VRTX)>0) OutData%VRTX = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%VRTX))-1 ), OutData%VRTX), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%VRTX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%VRTX,2), UBOUND(OutData%VRTX,2) + DO i1 = LBOUND(OutData%VRTX,1), UBOUND(OutData%VRTX,1) + OutData%VRTX(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%VRTX(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -4536,15 +4524,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%T_Sh)>0) OutData%T_Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%T_Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%T_Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%T_Sh,2), UBOUND(OutData%T_Sh,2) + DO i1 = LBOUND(OutData%T_Sh,1), UBOUND(OutData%T_Sh,1) + OutData%T_Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4562,15 +4547,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BEDSEP)>0) OutData%BEDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BEDSEP))-1 ), OutData%BEDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BEDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) + DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) + OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackMisc @@ -4616,6 +4598,7 @@ SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%OutSFmt = SrcParamData%OutSFmt DstParamData%Delim = SrcParamData%Delim DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%ShedEffect = SrcParamData%ShedEffect END SUBROUTINE UA_CopyParam SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -4684,6 +4667,7 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim Int_BufSz = Int_BufSz + 1 ! UnOutFile + Int_BufSz = Int_BufSz + 1 ! ShedEffect IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4711,8 +4695,8 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%c) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4726,37 +4710,43 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%c))-1 ) = PACK(InData%c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%c) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) + DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) + ReKiBuf(Re_Xferred) = InData%c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodesPerBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_PackParam SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4772,12 +4762,6 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4793,8 +4777,8 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4811,44 +4795,43 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%c)>0) OutData%c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%c) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) + DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) + OutData%c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_UnPackParam SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4948,14 +4931,14 @@ SUBROUTINE UA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%U - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%U + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackInput SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4971,12 +4954,6 @@ SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackInput' @@ -4990,14 +4967,14 @@ SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%U = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%U = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackInput SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -5120,16 +5097,16 @@ SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5140,8 +5117,10 @@ SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE UA_PackOutput @@ -5158,12 +5137,6 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5178,16 +5151,16 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5201,15 +5174,10 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE UA_UnPackOutput @@ -5288,8 +5256,8 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5304,14 +5272,16 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%U - u2%U)/t(2) - u_out%U = u1%U + b0 * t_out - b0 = -(u1%alpha - u2%alpha)/t(2) - u_out%alpha = u1%alpha + b0 * t_out - b0 = -(u1%Re - u2%Re)/t(2) - u_out%Re = u1%Re + b0 * t_out - b0 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%U - u2%U) + u_out%U = u1%U + b * ScaleFactor + b = -(u1%alpha - u2%alpha) + u_out%alpha = u1%alpha + b * ScaleFactor + b = -(u1%Re - u2%Re) + u_out%Re = u1%Re + b * ScaleFactor + b = -(u1%UserProp - u2%UserProp) + u_out%UserProp = u1%UserProp + b * ScaleFactor END SUBROUTINE UA_Input_ExtrapInterp1 @@ -5341,8 +5311,9 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp2' @@ -5364,18 +5335,20 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%U = u1%U + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha - u2%alpha) + t(2)**2*(-u1%alpha + u3%alpha))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha + t(3)*u2%alpha - t(2)*u3%alpha ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha = u1%alpha + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Re = u1%Re + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))* scaleFactor + c = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) * scaleFactor + u_out%U = u1%U + b + c * t_out + b = (t(3)**2*(u1%alpha - u2%alpha) + t(2)**2*(-u1%alpha + u3%alpha))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha + t(3)*u2%alpha - t(2)*u3%alpha ) * scaleFactor + u_out%alpha = u1%alpha + b + c * t_out + b = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))* scaleFactor + c = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) * scaleFactor + u_out%Re = u1%Re + b + c * t_out + b = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) * scaleFactor + u_out%UserProp = u1%UserProp + b + c * t_out END SUBROUTINE UA_Input_ExtrapInterp2 @@ -5453,12 +5426,12 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5471,23 +5444,23 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%Cn - y2%Cn)/t(2) - y_out%Cn = y1%Cn + b0 * t_out - b0 = -(y1%Cc - y2%Cc)/t(2) - y_out%Cc = y1%Cc + b0 * t_out - b0 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b0 * t_out - b0 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b0 * t_out - b0 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%Cn - y2%Cn) + y_out%Cn = y1%Cn + b * ScaleFactor + b = -(y1%Cc - y2%Cc) + y_out%Cc = y1%Cc + b * ScaleFactor + b = -(y1%Cm - y2%Cm) + y_out%Cm = y1%Cm + b * ScaleFactor + b = -(y1%Cl - y2%Cl) + y_out%Cl = y1%Cl + b * ScaleFactor + b = -(y1%Cd - y2%Cd) + y_out%Cd = y1%Cd + b * ScaleFactor IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE UA_Output_ExtrapInterp1 @@ -5518,13 +5491,14 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5543,29 +5517,29 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cn = y1%Cn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cc = y1%Cc + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))* scaleFactor + c = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) * scaleFactor + y_out%Cn = y1%Cn + b + c * t_out + b = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))* scaleFactor + c = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) * scaleFactor + y_out%Cc = y1%Cc + b + c * t_out + b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor + y_out%Cm = y1%Cm + b + c * t_out + b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor + y_out%Cl = y1%Cl + b + c * t_out + b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor + y_out%Cd = y1%Cd + b + c * t_out IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE UA_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/mod_root1dim.f90 b/modules/aerodyn/src/mod_root1dim.f90 index e31a992125..8dbe20d2d7 100644 --- a/modules/aerodyn/src/mod_root1dim.f90 +++ b/modules/aerodyn/src/mod_root1dim.f90 @@ -83,6 +83,10 @@ subroutine sub_brent(x,a_in,b_in, toler_in,maxiter_in,fcnArgs,AFInfo,fa_in,fb_in integer :: ErrStat_a character(ErrMsgLen) :: ErrMsg_a logical :: ValidPhi_a + + fcnArgs%errStat = ErrID_None + fcnArgs%ErrMsg = "" + ! Set of get parameters toler = 0.0_SolveKi; if (present(toler_in)) toler = toler_in ! Better to use custom toler here xtoler = xtoler_def; if (present(xtoler_in)) xtoler = xtoler_in diff --git a/modules/aerodyn/tests/test_FVW_testsuite.F90 b/modules/aerodyn/tests/test_FVW_testsuite.F90 new file mode 100644 index 0000000000..57a72ea24b --- /dev/null +++ b/modules/aerodyn/tests/test_FVW_testsuite.F90 @@ -0,0 +1,48 @@ +@test +subroutine test_AD_FVW() + ! test branches + ! - known valid checks for various FVW routines (contained in own module) + ! - known invalid rotation matrix: halve the angle of the diagonal elements + + use pFUnit_mod + use NWTC_Num + use FVW_Tests + + implicit none + + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(1024) :: testname + + ! initialize NWTC_Num constants + call SetConstants() + +!This is a single routine that contains the test cases below. + ! -------------------------------------------------------------------------- + testname = "Set of FVW tests" + call FVW_RunTests( ErrStat, ErrMsg ) + @assertEqual(0, ErrStat, testname) + + +! test routines from FVW_RunTests to be run individually -- except these are all private +! ! -------------------------------------------------------------------------- +! testname = "known valid Biot-Savart segment" +! call Test_BiotSavart_Sgmt(testname, ErrStat, ErrMsg) +! @assertEqual(0, ErrStat, testname) +! +! ! -------------------------------------------------------------------------- +! testname = "known valid Biot-Savart part" +! call Test_BiotSavart_Part(testname, ErrStat, ErrMsg) +! @assertEqual(0, ErrStat, testname) +! +! ! -------------------------------------------------------------------------- +! testname = "known valid Biot-Savart to part-tree" +! call Test_BiotSavart_PartTree(testname, ErrStat, ErrMsg) +! @assertEqual(0, ErrStat, testname) +! +! ! -------------------------------------------------------------------------- +! testname = "known valid segment split to parts" +! call Test_SegmentsToPart(testname, ErrStat, ErrMsg) +! @assertEqual(0, ErrStat, testname) + +end subroutine test_AD_FVW diff --git a/modules/aerodyn14/src/AD14AeroConf_Types.f90 b/modules/aerodyn14/src/AD14AeroConf_Types.f90 new file mode 100644 index 0000000000..91c5a37363 --- /dev/null +++ b/modules/aerodyn14/src/AD14AeroConf_Types.f90 @@ -0,0 +1,2921 @@ +!STARTOFREGISTRYGENERATEDFILE 'AD14AeroConf_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! AD14AeroConf_Types +!................................................................................................................................. +! This file is part of AD14AeroConf. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in AD14AeroConf. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE AD14AeroConf_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Marker ======= + TYPE, PUBLIC :: Marker + REAL(ReKi) , DIMENSION(1:3) :: Position + REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation + REAL(ReKi) , DIMENSION(1:3) :: TranslationVel + REAL(ReKi) , DIMENSION(1:3) :: RotationVel + END TYPE Marker +! ======================= +! ========= AD14AeroConf_MiscVarType ======= + TYPE, PUBLIC :: AD14AeroConf_MiscVarType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AL + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CD + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CL + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CM + REAL(ReKi) :: PMC + REAL(ReKi) :: MulTabLoc + END TYPE AD14AeroConf_MiscVarType +! ======================= +! ========= AD14AeroConf_ParameterType ======= + TYPE, PUBLIC :: AD14AeroConf_ParameterType + INTEGER(IntKi) :: MaxTable = 20 + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTables + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NLift + INTEGER(IntKi) :: NumCL + INTEGER(IntKi) :: NumFoil + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NFoil + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabMet + CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: FoilNm + END TYPE AD14AeroConf_ParameterType +! ======================= +! ========= AD14AeroConf_InputType ======= + TYPE, PUBLIC :: AD14AeroConf_InputType + TYPE(Marker) , DIMENSION(:), ALLOCATABLE :: Blade + TYPE(Marker) :: Hub + TYPE(Marker) :: RotorFurl + TYPE(Marker) :: Nacelle + TYPE(Marker) :: TailFin + TYPE(Marker) :: Tower + TYPE(Marker) :: SubStructure + TYPE(Marker) :: Foundation + REAL(ReKi) :: BladeLength + END TYPE AD14AeroConf_InputType +! ======================= +! ========= AD14AeroConf_OutputType ======= + TYPE, PUBLIC :: AD14AeroConf_OutputType + REAL(ReKi) :: Dummy + END TYPE AD14AeroConf_OutputType +! ======================= +CONTAINS + SUBROUTINE AD14AeroConf_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Marker), INTENT(IN) :: SrcMarkerData + TYPE(Marker), INTENT(INOUT) :: DstMarkerData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyMarker' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMarkerData%Position = SrcMarkerData%Position + DstMarkerData%Orientation = SrcMarkerData%Orientation + DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel + DstMarkerData%RotationVel = SrcMarkerData%RotationVel + END SUBROUTINE AD14AeroConf_CopyMarker + + SUBROUTINE AD14AeroConf_DestroyMarker( MarkerData, ErrStat, ErrMsg ) + TYPE(Marker), INTENT(INOUT) :: MarkerData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyMarker' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE AD14AeroConf_DestroyMarker + + SUBROUTINE AD14AeroConf_PackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Marker), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_PackMarker' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position + Re_BufSz = Re_BufSz + SIZE(InData%Orientation) ! Orientation + Re_BufSz = Re_BufSz + SIZE(InData%TranslationVel) ! TranslationVel + Re_BufSz = Re_BufSz + SIZE(InData%RotationVel) ! RotationVel + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%Position) + ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orientation))-1 ) = PACK(InData%Orientation,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%Orientation) + ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TranslationVel))-1 ) = PACK(InData%TranslationVel,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%TranslationVel) + ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotationVel))-1 ) = PACK(InData%RotationVel,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%RotationVel) + END SUBROUTINE AD14AeroConf_PackMarker + + SUBROUTINE AD14AeroConf_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Marker), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + LOGICAL :: mask0 + LOGICAL, ALLOCATABLE :: mask1(:) + LOGICAL, ALLOCATABLE :: mask2(:,:) + LOGICAL, ALLOCATABLE :: mask3(:,:,:) + LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) + LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_UnPackMarker' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%Position,1) + i1_u = UBOUND(OutData%Position,1) + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask1, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%Position) + DEALLOCATE(mask1) + i1_l = LBOUND(OutData%Orientation,1) + i1_u = UBOUND(OutData%Orientation,1) + i2_l = LBOUND(OutData%Orientation,2) + i2_u = UBOUND(OutData%Orientation,2) + ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask2 = .TRUE. + OutData%Orientation = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orientation))-1 ), mask2, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%Orientation) + DEALLOCATE(mask2) + i1_l = LBOUND(OutData%TranslationVel,1) + i1_u = UBOUND(OutData%TranslationVel,1) + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + OutData%TranslationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TranslationVel))-1 ), mask1, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%TranslationVel) + DEALLOCATE(mask1) + i1_l = LBOUND(OutData%RotationVel,1) + i1_u = UBOUND(OutData%RotationVel,1) + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + OutData%RotationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotationVel))-1 ), mask1, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%RotationVel) + DEALLOCATE(mask1) + END SUBROUTINE AD14AeroConf_UnPackMarker + + SUBROUTINE AD14AeroConf_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(AD14AeroConf_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscData%AL)) THEN + i1_l = LBOUND(SrcMiscData%AL,1) + i1_u = UBOUND(SrcMiscData%AL,1) + i2_l = LBOUND(SrcMiscData%AL,2) + i2_u = UBOUND(SrcMiscData%AL,2) + IF (.NOT. ALLOCATED(DstMiscData%AL)) THEN + ALLOCATE(DstMiscData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%AL = SrcMiscData%AL +ENDIF +IF (ALLOCATED(SrcMiscData%CD)) THEN + i1_l = LBOUND(SrcMiscData%CD,1) + i1_u = UBOUND(SrcMiscData%CD,1) + i2_l = LBOUND(SrcMiscData%CD,2) + i2_u = UBOUND(SrcMiscData%CD,2) + i3_l = LBOUND(SrcMiscData%CD,3) + i3_u = UBOUND(SrcMiscData%CD,3) + IF (.NOT. ALLOCATED(DstMiscData%CD)) THEN + ALLOCATE(DstMiscData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CD = SrcMiscData%CD +ENDIF +IF (ALLOCATED(SrcMiscData%CL)) THEN + i1_l = LBOUND(SrcMiscData%CL,1) + i1_u = UBOUND(SrcMiscData%CL,1) + i2_l = LBOUND(SrcMiscData%CL,2) + i2_u = UBOUND(SrcMiscData%CL,2) + i3_l = LBOUND(SrcMiscData%CL,3) + i3_u = UBOUND(SrcMiscData%CL,3) + IF (.NOT. ALLOCATED(DstMiscData%CL)) THEN + ALLOCATE(DstMiscData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CL = SrcMiscData%CL +ENDIF +IF (ALLOCATED(SrcMiscData%CM)) THEN + i1_l = LBOUND(SrcMiscData%CM,1) + i1_u = UBOUND(SrcMiscData%CM,1) + i2_l = LBOUND(SrcMiscData%CM,2) + i2_u = UBOUND(SrcMiscData%CM,2) + i3_l = LBOUND(SrcMiscData%CM,3) + i3_u = UBOUND(SrcMiscData%CM,3) + IF (.NOT. ALLOCATED(DstMiscData%CM)) THEN + ALLOCATE(DstMiscData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CM = SrcMiscData%CM +ENDIF + DstMiscData%PMC = SrcMiscData%PMC + DstMiscData%MulTabLoc = SrcMiscData%MulTabLoc + END SUBROUTINE AD14AeroConf_CopyMisc + + SUBROUTINE AD14AeroConf_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscData%AL)) THEN + DEALLOCATE(MiscData%AL) +ENDIF +IF (ALLOCATED(MiscData%CD)) THEN + DEALLOCATE(MiscData%CD) +ENDIF +IF (ALLOCATED(MiscData%CL)) THEN + DEALLOCATE(MiscData%CL) +ENDIF +IF (ALLOCATED(MiscData%CM)) THEN + DEALLOCATE(MiscData%CM) +ENDIF + END SUBROUTINE AD14AeroConf_DestroyMisc + + SUBROUTINE AD14AeroConf_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AD14AeroConf_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! AL allocated yes/no + IF ( ALLOCATED(InData%AL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AL) ! AL + END IF + Int_BufSz = Int_BufSz + 1 ! CD allocated yes/no + IF ( ALLOCATED(InData%CD) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! CD upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CD) ! CD + END IF + Int_BufSz = Int_BufSz + 1 ! CL allocated yes/no + IF ( ALLOCATED(InData%CL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! CL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CL) ! CL + END IF + Int_BufSz = Int_BufSz + 1 ! CM allocated yes/no + IF ( ALLOCATED(InData%CM) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! CM upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CM) ! CM + END IF + Re_BufSz = Re_BufSz + 1 ! PMC + Re_BufSz = Re_BufSz + 1 ! MulTabLoc + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%AL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%AL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AL))-1 ) = PACK(InData%AL,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%AL) + END IF + IF ( .NOT. ALLOCATED(InData%CD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%CD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CD))-1 ) = PACK(InData%CD,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%CD) + END IF + IF ( .NOT. ALLOCATED(InData%CL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%CL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CL))-1 ) = PACK(InData%CL,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%CL) + END IF + IF ( .NOT. ALLOCATED(InData%CM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%CM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CM))-1 ) = PACK(InData%CM,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%CM) + END IF + ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PMC + Re_Xferred = Re_Xferred + 1 + ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MulTabLoc + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD14AeroConf_PackMisc + + SUBROUTINE AD14AeroConf_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD14AeroConf_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + LOGICAL :: mask0 + LOGICAL, ALLOCATABLE :: mask1(:) + LOGICAL, ALLOCATABLE :: mask2(:,:) + LOGICAL, ALLOCATABLE :: mask3(:,:,:) + LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) + LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AL)) DEALLOCATE(OutData%AL) + ALLOCATE(OutData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask2 = .TRUE. + IF (SIZE(OutData%AL)>0) OutData%AL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AL))-1 ), mask2, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%AL) + DEALLOCATE(mask2) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CD)) DEALLOCATE(OutData%CD) + ALLOCATE(OutData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask3 = .TRUE. + IF (SIZE(OutData%CD)>0) OutData%CD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CD))-1 ), mask3, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%CD) + DEALLOCATE(mask3) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CL)) DEALLOCATE(OutData%CL) + ALLOCATE(OutData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask3 = .TRUE. + IF (SIZE(OutData%CL)>0) OutData%CL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CL))-1 ), mask3, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%CL) + DEALLOCATE(mask3) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CM)) DEALLOCATE(OutData%CM) + ALLOCATE(OutData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask3 = .TRUE. + IF (SIZE(OutData%CM)>0) OutData%CM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CM))-1 ), mask3, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%CM) + DEALLOCATE(mask3) + END IF + OutData%PMC = ReKiBuf( Re_Xferred ) + Re_Xferred = Re_Xferred + 1 + OutData%MulTabLoc = ReKiBuf( Re_Xferred ) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD14AeroConf_UnPackMisc + + SUBROUTINE AD14AeroConf_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_ParameterType), INTENT(IN) :: SrcParamData + TYPE(AD14AeroConf_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%MaxTable = SrcParamData%MaxTable +IF (ALLOCATED(SrcParamData%NTables)) THEN + i1_l = LBOUND(SrcParamData%NTables,1) + i1_u = UBOUND(SrcParamData%NTables,1) + IF (.NOT. ALLOCATED(DstParamData%NTables)) THEN + ALLOCATE(DstParamData%NTables(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NTables.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NTables = SrcParamData%NTables +ENDIF +IF (ALLOCATED(SrcParamData%NLift)) THEN + i1_l = LBOUND(SrcParamData%NLift,1) + i1_u = UBOUND(SrcParamData%NLift,1) + IF (.NOT. ALLOCATED(DstParamData%NLift)) THEN + ALLOCATE(DstParamData%NLift(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NLift.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NLift = SrcParamData%NLift +ENDIF + DstParamData%NumCL = SrcParamData%NumCL + DstParamData%NumFoil = SrcParamData%NumFoil +IF (ALLOCATED(SrcParamData%NFoil)) THEN + i1_l = LBOUND(SrcParamData%NFoil,1) + i1_u = UBOUND(SrcParamData%NFoil,1) + IF (.NOT. ALLOCATED(DstParamData%NFoil)) THEN + ALLOCATE(DstParamData%NFoil(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NFoil.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NFoil = SrcParamData%NFoil +ENDIF +IF (ALLOCATED(SrcParamData%MulTabMet)) THEN + i1_l = LBOUND(SrcParamData%MulTabMet,1) + i1_u = UBOUND(SrcParamData%MulTabMet,1) + i2_l = LBOUND(SrcParamData%MulTabMet,2) + i2_u = UBOUND(SrcParamData%MulTabMet,2) + IF (.NOT. ALLOCATED(DstParamData%MulTabMet)) THEN + ALLOCATE(DstParamData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MulTabMet.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%MulTabMet = SrcParamData%MulTabMet +ENDIF +IF (ALLOCATED(SrcParamData%FoilNm)) THEN + i1_l = LBOUND(SrcParamData%FoilNm,1) + i1_u = UBOUND(SrcParamData%FoilNm,1) + IF (.NOT. ALLOCATED(DstParamData%FoilNm)) THEN + ALLOCATE(DstParamData%FoilNm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FoilNm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%FoilNm = SrcParamData%FoilNm +ENDIF + END SUBROUTINE AD14AeroConf_CopyParam + + SUBROUTINE AD14AeroConf_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyParam' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ParamData%NTables)) THEN + DEALLOCATE(ParamData%NTables) +ENDIF +IF (ALLOCATED(ParamData%NLift)) THEN + DEALLOCATE(ParamData%NLift) +ENDIF +IF (ALLOCATED(ParamData%NFoil)) THEN + DEALLOCATE(ParamData%NFoil) +ENDIF +IF (ALLOCATED(ParamData%MulTabMet)) THEN + DEALLOCATE(ParamData%MulTabMet) +ENDIF +IF (ALLOCATED(ParamData%FoilNm)) THEN + DEALLOCATE(ParamData%FoilNm) +ENDIF + END SUBROUTINE AD14AeroConf_DestroyParam + + SUBROUTINE AD14AeroConf_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AD14AeroConf_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! MaxTable + Int_BufSz = Int_BufSz + 1 ! NTables allocated yes/no + IF ( ALLOCATED(InData%NTables) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NTables upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NTables) ! NTables + END IF + Int_BufSz = Int_BufSz + 1 ! NLift allocated yes/no + IF ( ALLOCATED(InData%NLift) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NLift upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NLift) ! NLift + END IF + Int_BufSz = Int_BufSz + 1 ! NumCL + Int_BufSz = Int_BufSz + 1 ! NumFoil + Int_BufSz = Int_BufSz + 1 ! NFoil allocated yes/no + IF ( ALLOCATED(InData%NFoil) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NFoil upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NFoil) ! NFoil + END IF + Int_BufSz = Int_BufSz + 1 ! MulTabMet allocated yes/no + IF ( ALLOCATED(InData%MulTabMet) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MulTabMet upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MulTabMet) ! MulTabMet + END IF + Int_BufSz = Int_BufSz + 1 ! FoilNm allocated yes/no + IF ( ALLOCATED(InData%FoilNm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FoilNm upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%FoilNm)*LEN(InData%FoilNm) ! FoilNm + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxTable + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%NTables) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NTables,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%NTables)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTables))-1 ) = PACK(InData%NTables,.TRUE.) + Int_Xferred = Int_Xferred + SIZE(InData%NTables) + END IF + IF ( .NOT. ALLOCATED(InData%NLift) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NLift,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%NLift)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NLift))-1 ) = PACK(InData%NLift,.TRUE.) + Int_Xferred = Int_Xferred + SIZE(InData%NLift) + END IF + IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCL + Int_Xferred = Int_Xferred + 1 + IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFoil + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NFoil,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%NFoil)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NFoil))-1 ) = PACK(InData%NFoil,.TRUE.) + Int_Xferred = Int_Xferred + SIZE(InData%NFoil) + END IF + IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) + Int_Xferred = Int_Xferred + 2 + + IF (SIZE(InData%MulTabMet)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabMet))-1 ) = PACK(InData%MulTabMet,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%MulTabMet) + END IF + IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FoilNm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) + DO I = 1, LEN(InData%FoilNm) + IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO !i1 + END IF + END SUBROUTINE AD14AeroConf_PackParam + + SUBROUTINE AD14AeroConf_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD14AeroConf_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + LOGICAL :: mask0 + LOGICAL, ALLOCATABLE :: mask1(:) + LOGICAL, ALLOCATABLE :: mask2(:,:) + LOGICAL, ALLOCATABLE :: mask3(:,:,:) + LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) + LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%MaxTable = IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NTables)) DEALLOCATE(OutData%NTables) + ALLOCATE(OutData%NTables(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + IF (SIZE(OutData%NTables)>0) OutData%NTables = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTables))-1 ), mask1, 0_IntKi ) + Int_Xferred = Int_Xferred + SIZE(OutData%NTables) + DEALLOCATE(mask1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NLift)) DEALLOCATE(OutData%NLift) + ALLOCATE(OutData%NLift(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + IF (SIZE(OutData%NLift)>0) OutData%NLift = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NLift))-1 ), mask1, 0_IntKi ) + Int_Xferred = Int_Xferred + SIZE(OutData%NLift) + DEALLOCATE(mask1) + END IF + OutData%NumCL = IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + OutData%NumFoil = IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NFoil)) DEALLOCATE(OutData%NFoil) + ALLOCATE(OutData%NFoil(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + IF (SIZE(OutData%NFoil)>0) OutData%NFoil = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NFoil))-1 ), mask1, 0_IntKi ) + Int_Xferred = Int_Xferred + SIZE(OutData%NFoil) + DEALLOCATE(mask1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MulTabMet)) DEALLOCATE(OutData%MulTabMet) + ALLOCATE(OutData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask2 = .TRUE. + IF (SIZE(OutData%MulTabMet)>0) OutData%MulTabMet = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabMet))-1 ), mask2, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%MulTabMet) + DEALLOCATE(mask2) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FoilNm)) DEALLOCATE(OutData%FoilNm) + ALLOCATE(OutData%FoilNm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) + DO I = 1, LEN(OutData%FoilNm) + OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO !i1 + DEALLOCATE(mask1) + END IF + END SUBROUTINE AD14AeroConf_UnPackParam + + SUBROUTINE AD14AeroConf_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_InputType), INTENT(IN) :: SrcInputData + TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInputData%Blade)) THEN + i1_l = LBOUND(SrcInputData%Blade,1) + i1_u = UBOUND(SrcInputData%Blade,1) + IF (.NOT. ALLOCATED(DstInputData%Blade)) THEN + ALLOCATE(DstInputData%Blade(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Blade.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputData%Blade,1), UBOUND(SrcInputData%Blade,1) + CALL AD14AeroConf_Copymarker( SrcInputData%Blade(i1), DstInputData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL AD14AeroConf_Copymarker( SrcInputData%Hub, DstInputData%Hub, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14AeroConf_Copymarker( SrcInputData%RotorFurl, DstInputData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14AeroConf_Copymarker( SrcInputData%Nacelle, DstInputData%Nacelle, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14AeroConf_Copymarker( SrcInputData%TailFin, DstInputData%TailFin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14AeroConf_Copymarker( SrcInputData%Tower, DstInputData%Tower, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14AeroConf_Copymarker( SrcInputData%SubStructure, DstInputData%SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14AeroConf_Copymarker( SrcInputData%Foundation, DstInputData%Foundation, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInputData%BladeLength = SrcInputData%BladeLength + END SUBROUTINE AD14AeroConf_CopyInput + + SUBROUTINE AD14AeroConf_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InputData%Blade)) THEN +DO i1 = LBOUND(InputData%Blade,1), UBOUND(InputData%Blade,1) + CALL AD14AeroConf_Destroymarker( InputData%Blade(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InputData%Blade) +ENDIF + CALL AD14AeroConf_Destroymarker( InputData%Hub, ErrStat, ErrMsg ) + CALL AD14AeroConf_Destroymarker( InputData%RotorFurl, ErrStat, ErrMsg ) + CALL AD14AeroConf_Destroymarker( InputData%Nacelle, ErrStat, ErrMsg ) + CALL AD14AeroConf_Destroymarker( InputData%TailFin, ErrStat, ErrMsg ) + CALL AD14AeroConf_Destroymarker( InputData%Tower, ErrStat, ErrMsg ) + CALL AD14AeroConf_Destroymarker( InputData%SubStructure, ErrStat, ErrMsg ) + CALL AD14AeroConf_Destroymarker( InputData%Foundation, ErrStat, ErrMsg ) + END SUBROUTINE AD14AeroConf_DestroyInput + + SUBROUTINE AD14AeroConf_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AD14AeroConf_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Blade allocated yes/no + IF ( ALLOCATED(InData%Blade) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Blade upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) + Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Blade + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Blade + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Blade + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Blade + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! Hub: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, .TRUE. ) ! Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Hub + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Hub + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Hub + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! RotorFurl: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurl + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! RotorFurl + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! RotorFurl + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! RotorFurl + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Nacelle: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, .TRUE. ) ! Nacelle + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Nacelle + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Nacelle + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Nacelle + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! TailFin: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, .TRUE. ) ! TailFin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TailFin + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TailFin + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TailFin + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Tower: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, .TRUE. ) ! Tower + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Tower + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Tower + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Tower + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SubStructure: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SubStructure + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SubStructure + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SubStructure + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Foundation: size of buffers for each call to pack subtype + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, .TRUE. ) ! Foundation + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Foundation + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Foundation + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Foundation + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Re_BufSz = Re_BufSz + 1 ! BladeLength + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%Blade) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Blade,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Blade,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, OnlySize ) ! Blade + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, OnlySize ) ! Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurl + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, OnlySize ) ! Nacelle + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, OnlySize ) ! TailFin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, OnlySize ) ! Tower + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, OnlySize ) ! Foundation + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD14AeroConf_PackInput + + SUBROUTINE AD14AeroConf_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + LOGICAL :: mask0 + LOGICAL, ALLOCATABLE :: mask1(:) + LOGICAL, ALLOCATABLE :: mask2(:,:) + LOGICAL, ALLOCATABLE :: mask3(:,:,:) + LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) + LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Blade not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Blade)) DEALLOCATE(OutData%Blade) + ALLOCATE(OutData%Blade(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Blade,1), UBOUND(OutData%Blade,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Blade(i1), ErrStat2, ErrMsg2 ) ! Blade + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%BladeLength = ReKiBuf( Re_Xferred ) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD14AeroConf_UnPackInput + + SUBROUTINE AD14AeroConf_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: SrcOutputData + TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOutputData%Dummy = SrcOutputData%Dummy + END SUBROUTINE AD14AeroConf_CopyOutput + + SUBROUTINE AD14AeroConf_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE AD14AeroConf_DestroyOutput + + SUBROUTINE AD14AeroConf_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! Dummy + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD14AeroConf_PackOutput + + SUBROUTINE AD14AeroConf_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + LOGICAL :: mask0 + LOGICAL, ALLOCATABLE :: mask1(:) + LOGICAL, ALLOCATABLE :: mask2(:,:) + LOGICAL, ALLOCATABLE :: mask3(:,:,:) + LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) + LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%Dummy = ReKiBuf( Re_Xferred ) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE AD14AeroConf_UnPackOutput + + + SUBROUTINE AD14AeroConf_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(AD14AeroConf_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL AD14AeroConf_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL AD14AeroConf_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL AD14AeroConf_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE AD14AeroConf_Input_ExtrapInterp + + + SUBROUTINE AD14AeroConf_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(AD14AeroConf_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(AD14AeroConf_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Input_ExtrapInterp1' + REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF +IF (ALLOCATED(u_out%Blade) .AND. ALLOCATED(u1%Blade)) THEN + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b1(SIZE(u_out%Blade(i01)%Position,1))) + ALLOCATE(c1(SIZE(u_out%Blade(i01)%Position,1))) + b1 = -(u1%Blade(i01)%Position - u2%Blade(i01)%Position)/t(2) + u_out%Blade(i01)%Position = u1%Blade(i01)%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ENDDO + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) + b2 = -(u1%Blade(i01)%Orientation - u2%Blade(i01)%Orientation)/t(2) + u_out%Blade(i01)%Orientation = u1%Blade(i01)%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ENDDO + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b1(SIZE(u_out%Blade(i01)%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Blade(i01)%TranslationVel,1))) + b1 = -(u1%Blade(i01)%TranslationVel - u2%Blade(i01)%TranslationVel)/t(2) + u_out%Blade(i01)%TranslationVel = u1%Blade(i01)%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ENDDO + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b1(SIZE(u_out%Blade(i01)%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Blade(i01)%RotationVel,1))) + b1 = -(u1%Blade(i01)%RotationVel - u2%Blade(i01)%RotationVel)/t(2) + u_out%Blade(i01)%RotationVel = u1%Blade(i01)%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ENDDO +END IF ! check if allocated + ALLOCATE(b1(SIZE(u_out%Hub%Position,1))) + ALLOCATE(c1(SIZE(u_out%Hub%Position,1))) + b1 = -(u1%Hub%Position - u2%Hub%Position)/t(2) + u_out%Hub%Position = u1%Hub%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) + b2 = -(u1%Hub%Orientation - u2%Hub%Orientation)/t(2) + u_out%Hub%Orientation = u1%Hub%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Hub%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Hub%TranslationVel,1))) + b1 = -(u1%Hub%TranslationVel - u2%Hub%TranslationVel)/t(2) + u_out%Hub%TranslationVel = u1%Hub%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Hub%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Hub%RotationVel,1))) + b1 = -(u1%Hub%RotationVel - u2%Hub%RotationVel)/t(2) + u_out%Hub%RotationVel = u1%Hub%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%RotorFurl%Position,1))) + ALLOCATE(c1(SIZE(u_out%RotorFurl%Position,1))) + b1 = -(u1%RotorFurl%Position - u2%RotorFurl%Position)/t(2) + u_out%RotorFurl%Position = u1%RotorFurl%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) + b2 = -(u1%RotorFurl%Orientation - u2%RotorFurl%Orientation)/t(2) + u_out%RotorFurl%Orientation = u1%RotorFurl%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%RotorFurl%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%RotorFurl%TranslationVel,1))) + b1 = -(u1%RotorFurl%TranslationVel - u2%RotorFurl%TranslationVel)/t(2) + u_out%RotorFurl%TranslationVel = u1%RotorFurl%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%RotorFurl%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%RotorFurl%RotationVel,1))) + b1 = -(u1%RotorFurl%RotationVel - u2%RotorFurl%RotationVel)/t(2) + u_out%RotorFurl%RotationVel = u1%RotorFurl%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Nacelle%Position,1))) + ALLOCATE(c1(SIZE(u_out%Nacelle%Position,1))) + b1 = -(u1%Nacelle%Position - u2%Nacelle%Position)/t(2) + u_out%Nacelle%Position = u1%Nacelle%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) + b2 = -(u1%Nacelle%Orientation - u2%Nacelle%Orientation)/t(2) + u_out%Nacelle%Orientation = u1%Nacelle%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Nacelle%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Nacelle%TranslationVel,1))) + b1 = -(u1%Nacelle%TranslationVel - u2%Nacelle%TranslationVel)/t(2) + u_out%Nacelle%TranslationVel = u1%Nacelle%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Nacelle%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Nacelle%RotationVel,1))) + b1 = -(u1%Nacelle%RotationVel - u2%Nacelle%RotationVel)/t(2) + u_out%Nacelle%RotationVel = u1%Nacelle%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%TailFin%Position,1))) + ALLOCATE(c1(SIZE(u_out%TailFin%Position,1))) + b1 = -(u1%TailFin%Position - u2%TailFin%Position)/t(2) + u_out%TailFin%Position = u1%TailFin%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) + b2 = -(u1%TailFin%Orientation - u2%TailFin%Orientation)/t(2) + u_out%TailFin%Orientation = u1%TailFin%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%TailFin%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%TailFin%TranslationVel,1))) + b1 = -(u1%TailFin%TranslationVel - u2%TailFin%TranslationVel)/t(2) + u_out%TailFin%TranslationVel = u1%TailFin%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%TailFin%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%TailFin%RotationVel,1))) + b1 = -(u1%TailFin%RotationVel - u2%TailFin%RotationVel)/t(2) + u_out%TailFin%RotationVel = u1%TailFin%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Tower%Position,1))) + ALLOCATE(c1(SIZE(u_out%Tower%Position,1))) + b1 = -(u1%Tower%Position - u2%Tower%Position)/t(2) + u_out%Tower%Position = u1%Tower%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) + b2 = -(u1%Tower%Orientation - u2%Tower%Orientation)/t(2) + u_out%Tower%Orientation = u1%Tower%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Tower%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Tower%TranslationVel,1))) + b1 = -(u1%Tower%TranslationVel - u2%Tower%TranslationVel)/t(2) + u_out%Tower%TranslationVel = u1%Tower%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Tower%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Tower%RotationVel,1))) + b1 = -(u1%Tower%RotationVel - u2%Tower%RotationVel)/t(2) + u_out%Tower%RotationVel = u1%Tower%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%SubStructure%Position,1))) + ALLOCATE(c1(SIZE(u_out%SubStructure%Position,1))) + b1 = -(u1%SubStructure%Position - u2%SubStructure%Position)/t(2) + u_out%SubStructure%Position = u1%SubStructure%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) + b2 = -(u1%SubStructure%Orientation - u2%SubStructure%Orientation)/t(2) + u_out%SubStructure%Orientation = u1%SubStructure%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%SubStructure%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%SubStructure%TranslationVel,1))) + b1 = -(u1%SubStructure%TranslationVel - u2%SubStructure%TranslationVel)/t(2) + u_out%SubStructure%TranslationVel = u1%SubStructure%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%SubStructure%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%SubStructure%RotationVel,1))) + b1 = -(u1%SubStructure%RotationVel - u2%SubStructure%RotationVel)/t(2) + u_out%SubStructure%RotationVel = u1%SubStructure%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Foundation%Position,1))) + ALLOCATE(c1(SIZE(u_out%Foundation%Position,1))) + b1 = -(u1%Foundation%Position - u2%Foundation%Position)/t(2) + u_out%Foundation%Position = u1%Foundation%Position + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) + b2 = -(u1%Foundation%Orientation - u2%Foundation%Orientation)/t(2) + u_out%Foundation%Orientation = u1%Foundation%Orientation + b2 * t_out + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Foundation%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Foundation%TranslationVel,1))) + b1 = -(u1%Foundation%TranslationVel - u2%Foundation%TranslationVel)/t(2) + u_out%Foundation%TranslationVel = u1%Foundation%TranslationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Foundation%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Foundation%RotationVel,1))) + b1 = -(u1%Foundation%RotationVel - u2%Foundation%RotationVel)/t(2) + u_out%Foundation%RotationVel = u1%Foundation%RotationVel + b1 * t_out + DEALLOCATE(b1) + DEALLOCATE(c1) + b0 = -(u1%BladeLength - u2%BladeLength)/t(2) + u_out%BladeLength = u1%BladeLength + b0 * t_out + END SUBROUTINE AD14AeroConf_Input_ExtrapInterp1 + + + SUBROUTINE AD14AeroConf_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(AD14AeroConf_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(AD14AeroConf_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(AD14AeroConf_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation + REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF +IF (ALLOCATED(u_out%Blade) .AND. ALLOCATED(u1%Blade)) THEN + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b1(SIZE(u_out%Blade(i01)%Position,1))) + ALLOCATE(c1(SIZE(u_out%Blade(i01)%Position,1))) + b1 = (t(3)**2*(u1%Blade(i01)%Position - u2%Blade(i01)%Position) + t(2)**2*(-u1%Blade(i01)%Position + u3%Blade(i01)%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Blade(i01)%Position + t(3)*u2%Blade(i01)%Position - t(2)*u3%Blade(i01)%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Blade(i01)%Position = u1%Blade(i01)%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ENDDO + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) + b2 = (t(3)**2*(u1%Blade(i01)%Orientation - u2%Blade(i01)%Orientation) + t(2)**2*(-u1%Blade(i01)%Orientation + u3%Blade(i01)%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%Blade(i01)%Orientation + t(3)*u2%Blade(i01)%Orientation - t(2)*u3%Blade(i01)%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Blade(i01)%Orientation = u1%Blade(i01)%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ENDDO + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b1(SIZE(u_out%Blade(i01)%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Blade(i01)%TranslationVel,1))) + b1 = (t(3)**2*(u1%Blade(i01)%TranslationVel - u2%Blade(i01)%TranslationVel) + t(2)**2*(-u1%Blade(i01)%TranslationVel + u3%Blade(i01)%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Blade(i01)%TranslationVel + t(3)*u2%Blade(i01)%TranslationVel - t(2)*u3%Blade(i01)%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Blade(i01)%TranslationVel = u1%Blade(i01)%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ENDDO + DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) + ALLOCATE(b1(SIZE(u_out%Blade(i01)%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Blade(i01)%RotationVel,1))) + b1 = (t(3)**2*(u1%Blade(i01)%RotationVel - u2%Blade(i01)%RotationVel) + t(2)**2*(-u1%Blade(i01)%RotationVel + u3%Blade(i01)%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Blade(i01)%RotationVel + t(3)*u2%Blade(i01)%RotationVel - t(2)*u3%Blade(i01)%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Blade(i01)%RotationVel = u1%Blade(i01)%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ENDDO +END IF ! check if allocated + ALLOCATE(b1(SIZE(u_out%Hub%Position,1))) + ALLOCATE(c1(SIZE(u_out%Hub%Position,1))) + b1 = (t(3)**2*(u1%Hub%Position - u2%Hub%Position) + t(2)**2*(-u1%Hub%Position + u3%Hub%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Hub%Position + t(3)*u2%Hub%Position - t(2)*u3%Hub%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Hub%Position = u1%Hub%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) + b2 = (t(3)**2*(u1%Hub%Orientation - u2%Hub%Orientation) + t(2)**2*(-u1%Hub%Orientation + u3%Hub%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%Hub%Orientation + t(3)*u2%Hub%Orientation - t(2)*u3%Hub%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Hub%Orientation = u1%Hub%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Hub%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Hub%TranslationVel,1))) + b1 = (t(3)**2*(u1%Hub%TranslationVel - u2%Hub%TranslationVel) + t(2)**2*(-u1%Hub%TranslationVel + u3%Hub%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Hub%TranslationVel + t(3)*u2%Hub%TranslationVel - t(2)*u3%Hub%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Hub%TranslationVel = u1%Hub%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Hub%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Hub%RotationVel,1))) + b1 = (t(3)**2*(u1%Hub%RotationVel - u2%Hub%RotationVel) + t(2)**2*(-u1%Hub%RotationVel + u3%Hub%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Hub%RotationVel + t(3)*u2%Hub%RotationVel - t(2)*u3%Hub%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Hub%RotationVel = u1%Hub%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%RotorFurl%Position,1))) + ALLOCATE(c1(SIZE(u_out%RotorFurl%Position,1))) + b1 = (t(3)**2*(u1%RotorFurl%Position - u2%RotorFurl%Position) + t(2)**2*(-u1%RotorFurl%Position + u3%RotorFurl%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%RotorFurl%Position + t(3)*u2%RotorFurl%Position - t(2)*u3%RotorFurl%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%RotorFurl%Position = u1%RotorFurl%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) + b2 = (t(3)**2*(u1%RotorFurl%Orientation - u2%RotorFurl%Orientation) + t(2)**2*(-u1%RotorFurl%Orientation + u3%RotorFurl%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%RotorFurl%Orientation + t(3)*u2%RotorFurl%Orientation - t(2)*u3%RotorFurl%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%RotorFurl%Orientation = u1%RotorFurl%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%RotorFurl%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%RotorFurl%TranslationVel,1))) + b1 = (t(3)**2*(u1%RotorFurl%TranslationVel - u2%RotorFurl%TranslationVel) + t(2)**2*(-u1%RotorFurl%TranslationVel + u3%RotorFurl%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%RotorFurl%TranslationVel + t(3)*u2%RotorFurl%TranslationVel - t(2)*u3%RotorFurl%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%RotorFurl%TranslationVel = u1%RotorFurl%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%RotorFurl%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%RotorFurl%RotationVel,1))) + b1 = (t(3)**2*(u1%RotorFurl%RotationVel - u2%RotorFurl%RotationVel) + t(2)**2*(-u1%RotorFurl%RotationVel + u3%RotorFurl%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%RotorFurl%RotationVel + t(3)*u2%RotorFurl%RotationVel - t(2)*u3%RotorFurl%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%RotorFurl%RotationVel = u1%RotorFurl%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Nacelle%Position,1))) + ALLOCATE(c1(SIZE(u_out%Nacelle%Position,1))) + b1 = (t(3)**2*(u1%Nacelle%Position - u2%Nacelle%Position) + t(2)**2*(-u1%Nacelle%Position + u3%Nacelle%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Nacelle%Position + t(3)*u2%Nacelle%Position - t(2)*u3%Nacelle%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Nacelle%Position = u1%Nacelle%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) + b2 = (t(3)**2*(u1%Nacelle%Orientation - u2%Nacelle%Orientation) + t(2)**2*(-u1%Nacelle%Orientation + u3%Nacelle%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%Nacelle%Orientation + t(3)*u2%Nacelle%Orientation - t(2)*u3%Nacelle%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Nacelle%Orientation = u1%Nacelle%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Nacelle%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Nacelle%TranslationVel,1))) + b1 = (t(3)**2*(u1%Nacelle%TranslationVel - u2%Nacelle%TranslationVel) + t(2)**2*(-u1%Nacelle%TranslationVel + u3%Nacelle%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Nacelle%TranslationVel + t(3)*u2%Nacelle%TranslationVel - t(2)*u3%Nacelle%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Nacelle%TranslationVel = u1%Nacelle%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Nacelle%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Nacelle%RotationVel,1))) + b1 = (t(3)**2*(u1%Nacelle%RotationVel - u2%Nacelle%RotationVel) + t(2)**2*(-u1%Nacelle%RotationVel + u3%Nacelle%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Nacelle%RotationVel + t(3)*u2%Nacelle%RotationVel - t(2)*u3%Nacelle%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Nacelle%RotationVel = u1%Nacelle%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%TailFin%Position,1))) + ALLOCATE(c1(SIZE(u_out%TailFin%Position,1))) + b1 = (t(3)**2*(u1%TailFin%Position - u2%TailFin%Position) + t(2)**2*(-u1%TailFin%Position + u3%TailFin%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%TailFin%Position + t(3)*u2%TailFin%Position - t(2)*u3%TailFin%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%TailFin%Position = u1%TailFin%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) + b2 = (t(3)**2*(u1%TailFin%Orientation - u2%TailFin%Orientation) + t(2)**2*(-u1%TailFin%Orientation + u3%TailFin%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%TailFin%Orientation + t(3)*u2%TailFin%Orientation - t(2)*u3%TailFin%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%TailFin%Orientation = u1%TailFin%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%TailFin%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%TailFin%TranslationVel,1))) + b1 = (t(3)**2*(u1%TailFin%TranslationVel - u2%TailFin%TranslationVel) + t(2)**2*(-u1%TailFin%TranslationVel + u3%TailFin%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%TailFin%TranslationVel + t(3)*u2%TailFin%TranslationVel - t(2)*u3%TailFin%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%TailFin%TranslationVel = u1%TailFin%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%TailFin%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%TailFin%RotationVel,1))) + b1 = (t(3)**2*(u1%TailFin%RotationVel - u2%TailFin%RotationVel) + t(2)**2*(-u1%TailFin%RotationVel + u3%TailFin%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%TailFin%RotationVel + t(3)*u2%TailFin%RotationVel - t(2)*u3%TailFin%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%TailFin%RotationVel = u1%TailFin%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Tower%Position,1))) + ALLOCATE(c1(SIZE(u_out%Tower%Position,1))) + b1 = (t(3)**2*(u1%Tower%Position - u2%Tower%Position) + t(2)**2*(-u1%Tower%Position + u3%Tower%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Tower%Position + t(3)*u2%Tower%Position - t(2)*u3%Tower%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Tower%Position = u1%Tower%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) + b2 = (t(3)**2*(u1%Tower%Orientation - u2%Tower%Orientation) + t(2)**2*(-u1%Tower%Orientation + u3%Tower%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%Tower%Orientation + t(3)*u2%Tower%Orientation - t(2)*u3%Tower%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Tower%Orientation = u1%Tower%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Tower%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Tower%TranslationVel,1))) + b1 = (t(3)**2*(u1%Tower%TranslationVel - u2%Tower%TranslationVel) + t(2)**2*(-u1%Tower%TranslationVel + u3%Tower%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Tower%TranslationVel + t(3)*u2%Tower%TranslationVel - t(2)*u3%Tower%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Tower%TranslationVel = u1%Tower%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Tower%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Tower%RotationVel,1))) + b1 = (t(3)**2*(u1%Tower%RotationVel - u2%Tower%RotationVel) + t(2)**2*(-u1%Tower%RotationVel + u3%Tower%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Tower%RotationVel + t(3)*u2%Tower%RotationVel - t(2)*u3%Tower%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Tower%RotationVel = u1%Tower%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%SubStructure%Position,1))) + ALLOCATE(c1(SIZE(u_out%SubStructure%Position,1))) + b1 = (t(3)**2*(u1%SubStructure%Position - u2%SubStructure%Position) + t(2)**2*(-u1%SubStructure%Position + u3%SubStructure%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%SubStructure%Position + t(3)*u2%SubStructure%Position - t(2)*u3%SubStructure%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%SubStructure%Position = u1%SubStructure%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) + b2 = (t(3)**2*(u1%SubStructure%Orientation - u2%SubStructure%Orientation) + t(2)**2*(-u1%SubStructure%Orientation + u3%SubStructure%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%SubStructure%Orientation + t(3)*u2%SubStructure%Orientation - t(2)*u3%SubStructure%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%SubStructure%Orientation = u1%SubStructure%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%SubStructure%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%SubStructure%TranslationVel,1))) + b1 = (t(3)**2*(u1%SubStructure%TranslationVel - u2%SubStructure%TranslationVel) + t(2)**2*(-u1%SubStructure%TranslationVel + u3%SubStructure%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%SubStructure%TranslationVel + t(3)*u2%SubStructure%TranslationVel - t(2)*u3%SubStructure%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%SubStructure%TranslationVel = u1%SubStructure%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%SubStructure%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%SubStructure%RotationVel,1))) + b1 = (t(3)**2*(u1%SubStructure%RotationVel - u2%SubStructure%RotationVel) + t(2)**2*(-u1%SubStructure%RotationVel + u3%SubStructure%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%SubStructure%RotationVel + t(3)*u2%SubStructure%RotationVel - t(2)*u3%SubStructure%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%SubStructure%RotationVel = u1%SubStructure%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Foundation%Position,1))) + ALLOCATE(c1(SIZE(u_out%Foundation%Position,1))) + b1 = (t(3)**2*(u1%Foundation%Position - u2%Foundation%Position) + t(2)**2*(-u1%Foundation%Position + u3%Foundation%Position))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Foundation%Position + t(3)*u2%Foundation%Position - t(2)*u3%Foundation%Position ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Foundation%Position = u1%Foundation%Position + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) + ALLOCATE(c2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) + b2 = (t(3)**2*(u1%Foundation%Orientation - u2%Foundation%Orientation) + t(2)**2*(-u1%Foundation%Orientation + u3%Foundation%Orientation))/(t(2)*t(3)*(t(2) - t(3))) + c2 = ( (t(2)-t(3))*u1%Foundation%Orientation + t(3)*u2%Foundation%Orientation - t(2)*u3%Foundation%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Foundation%Orientation = u1%Foundation%Orientation + b2 * t_out + c2 * t_out**2 + DEALLOCATE(b2) + DEALLOCATE(c2) + ALLOCATE(b1(SIZE(u_out%Foundation%TranslationVel,1))) + ALLOCATE(c1(SIZE(u_out%Foundation%TranslationVel,1))) + b1 = (t(3)**2*(u1%Foundation%TranslationVel - u2%Foundation%TranslationVel) + t(2)**2*(-u1%Foundation%TranslationVel + u3%Foundation%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Foundation%TranslationVel + t(3)*u2%Foundation%TranslationVel - t(2)*u3%Foundation%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Foundation%TranslationVel = u1%Foundation%TranslationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + ALLOCATE(b1(SIZE(u_out%Foundation%RotationVel,1))) + ALLOCATE(c1(SIZE(u_out%Foundation%RotationVel,1))) + b1 = (t(3)**2*(u1%Foundation%RotationVel - u2%Foundation%RotationVel) + t(2)**2*(-u1%Foundation%RotationVel + u3%Foundation%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) + c1 = ( (t(2)-t(3))*u1%Foundation%RotationVel + t(3)*u2%Foundation%RotationVel - t(2)*u3%Foundation%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%Foundation%RotationVel = u1%Foundation%RotationVel + b1 * t_out + c1 * t_out**2 + DEALLOCATE(b1) + DEALLOCATE(c1) + b0 = (t(3)**2*(u1%BladeLength - u2%BladeLength) + t(2)**2*(-u1%BladeLength + u3%BladeLength))/(t(2)*t(3)*(t(2) - t(3))) + c0 = ( (t(2)-t(3))*u1%BladeLength + t(3)*u2%BladeLength - t(2)*u3%BladeLength ) / (t(2)*t(3)*(t(2) - t(3))) + u_out%BladeLength = u1%BladeLength + b0 * t_out + c0 * t_out**2 + END SUBROUTINE AD14AeroConf_Input_ExtrapInterp2 + + + SUBROUTINE AD14AeroConf_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL AD14AeroConf_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL AD14AeroConf_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL AD14AeroConf_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE AD14AeroConf_Output_ExtrapInterp + + + SUBROUTINE AD14AeroConf_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Output_ExtrapInterp1' + REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + b0 = -(y1%Dummy - y2%Dummy)/t(2) + y_out%Dummy = y1%Dummy + b0 * t_out + END SUBROUTINE AD14AeroConf_Output_ExtrapInterp1 + + + SUBROUTINE AD14AeroConf_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Output_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + b0 = (t(3)**2*(y1%Dummy - y2%Dummy) + t(2)**2*(-y1%Dummy + y3%Dummy))/(t(2)*t(3)*(t(2) - t(3))) + c0 = ( (t(2)-t(3))*y1%Dummy + t(3)*y2%Dummy - t(2)*y3%Dummy ) / (t(2)*t(3)*(t(2) - t(3))) + y_out%Dummy = y1%Dummy + b0 * t_out + c0 * t_out**2 + END SUBROUTINE AD14AeroConf_Output_ExtrapInterp2 + +END MODULE AD14AeroConf_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroDyn14.f90 b/modules/aerodyn14/src/AeroDyn14.f90 index 321d114d76..b608cef645 100644 --- a/modules/aerodyn14/src/AeroDyn14.f90 +++ b/modules/aerodyn14/src/AeroDyn14.f90 @@ -165,6 +165,11 @@ SUBROUTINE AD14_Init( InitInp, u, p, x, xd, z, O, y, m, Interval, InitOut, ErrSt CALL AllocAry(m%Element%Alpha, p%Element%NELM, p%NumBl,'m%Element%Alpha',ErrStatLcl,ErrMessLcl ) CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) END IF + + IF (.NOT. ALLOCATED(m%Element%PitNow) ) THEN + CALL AllocAry(m%Element%PitNow, p%Element%NELM, p%NumBl,'m%Element%PitNow',ErrStatLcl,ErrMessLcl ) + CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) + END IF IF (ErrStat >= AbortErrLev ) RETURN @@ -726,6 +731,7 @@ SUBROUTINE AD14_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrSt ! identify which variables are states. END SUBROUTINE AD14_UpdateStates + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) ! Routine for computing outputs, used in both loose and tight coupling. @@ -736,11 +742,11 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) USE DWM REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(AD14_InputType), INTENT(IN ) :: u ! Inputs at Time + TYPE(AD14_InputType), INTENT(INOUT) :: u ! Inputs at Time TYPE(AD14_ParameterType), INTENT(IN ) :: p ! Parameters TYPE(AD14_ContinuousStateType), INTENT(IN ) :: x ! Continuous states at Time TYPE(AD14_DiscreteStateType), INTENT(IN ) :: xd ! Discrete states at Time - TYPE(AD14_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at Time + TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Constraint states at Time TYPE(AD14_OtherStateType), INTENT(IN ) :: O ! Other states at Time TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (Input only so that mesh con- ! nectivity information does not have to be recalculated) @@ -752,15 +758,22 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) ! Local variables REAL(DbKi), PARAMETER :: OnePlusEpsilon = 1 + EPSILON(Time) - REAL(ReKi) :: VNElement REAL(ReKi) :: VelNormalToRotor2 + REAL(ReKi) :: VTWind REAL(ReKi) :: VNWind + REAL(ReKi) :: VNElement + REAL(ReKi) :: VTElement + REAL(ReKi) :: VN_ind + REAL(ReKi) :: VT_ind + REAL(ReKi) :: VN + REAL(ReKi) :: VT REAL(ReKi) :: VTTotal REAL(ReKi) :: DFN REAL(ReKi) :: DFT REAL(ReKi) :: PMA REAL(ReKi) :: SPitch ! sine of PitNow REAL(ReKi) :: CPitch ! cosine of PitNow + REAL(ReKi) :: Phi ! Local value of Phi REAL(ReKi) :: AvgVelNacelleRotorFurlYaw REAL(ReKi) :: AvgVelTowerBaseNacelleYaw @@ -772,6 +785,8 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) REAL(ReKi) :: rTowerBaseHub (2) REAL(ReKi) :: tmpVector (3) + REAL(ReKi) :: norm_Vector (3) ! Unit vector normal to chord + REAL(ReKi) :: tang_Vector (3) ! Unit vector tangent to chord REAL(ReKi) :: VelocityVec (3) INTEGER :: ErrStatLcL ! Error status returned by called routines. @@ -782,7 +797,7 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) INTEGER :: I CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_AeroSubs' !KS Not sure why I added this ! Initialize ErrStat ErrStat = ErrID_None @@ -913,7 +928,20 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) ! end of NewTime routine !................................................................................................. + ! Set blade element pitches + DO IBlade = 1,p%NumBl + DO IElement = 1,p%Element%NElm + ! calculate element pitch + m%Element%PitNow(IElement,IBlade) = -1.*ATAN2( -1.*DOT_PRODUCT( u%TurbineComponents%Blade(IBlade)%Orientation(1,:), & + u%InputMarkers(IBlade)%Orientation(2,:,IElement) ) , & + DOT_PRODUCT( u%TurbineComponents%Blade(IBlade)%Orientation(1,:), & + u%InputMarkers(IBlade)%Orientation(1,:,IElement) ) ) + ENDDO + ENDDO + + Node = 0 + ! --- Loop on blades DO IBlade = 1,p%NumBl ! calculate the azimuth angle ( we add pi because AeroDyn defines 0 as pointing downward) @@ -924,24 +952,13 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) u%TurbineComponents%RotorFurl%Orientation(2,:) ), & DOT_PRODUCT( u%TurbineComponents%Hub%Orientation(3,:), & u%TurbineComponents%RotorFurl%Orientation(3,:) ) ) + pi + (IBlade - 1)*p%TwoPiNB - - - + ! --- Loop on elements DO IElement = 1,p%Element%NElm - ! calculate element pitch - - m%Element%PitNow = -1.*ATAN2( -1.*DOT_PRODUCT( u%TurbineComponents%Blade(IBlade)%Orientation(1,:), & - u%InputMarkers(IBlade)%Orientation(2,:,IElement) ) , & - DOT_PRODUCT( u%TurbineComponents%Blade(IBlade)%Orientation(1,:), & - u%InputMarkers(IBlade)%Orientation(1,:,IElement) ) ) - - SPitch = SIN( m%Element%PitNow ) - CPitch = COS( m%Element%PitNow ) - + SPitch = SIN( m%Element%PitNow(IElement,IBlade) ) + CPitch = COS( m%Element%PitNow(IElement,IBlade) ) ! calculate distance between hub and element - tmpVector = u%InputMarkers(IBlade)%Position(:,IElement) - u%TurbineComponents%Hub%Position(:) rLocal = SQRT( DOT_PRODUCT( tmpVector, u%TurbineComponents%Hub%Orientation(2,:) )**2 & + DOT_PRODUCT( tmpVector, u%TurbineComponents%Hub%Orientation(3,:) )**2 ) @@ -1028,30 +1045,53 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) !----------------------------------------------------------------------------------------------------------------------- - - - + ! NOTE: VelocityVec is freestream with disturbances from Tower Shadow and Wakes (DWM) VelNormalToRotor2 = ( VelocityVec(3) * m%Rotor%STilt + (VelocityVec(1) * m%Rotor%CYaw & - VelocityVec(2) * m%Rotor%SYaw) * m%Rotor%CTilt )**2 !------------------------------------------------------------------------------------------- - ! reproduce GetVNVT routine: + ! Normal and tangential velocities from wind and relative blade motion !------------------------------------------------------------------------------------------- - tmpVector = -1.*SPitch*u%InputMarkers(IBlade)%Orientation(1,:,IElement) & - + CPitch*u%InputMarkers(IBlade)%Orientation(2,:,IElement) - VTTotal = DOT_PRODUCT( tmpVector, VelocityVec - u%InputMarkers(IBlade)%TranslationVel(:,IElement) ) + tang_Vector = - SPitch*u%InputMarkers(IBlade)%Orientation(1,:,IElement) & + & + CPitch*u%InputMarkers(IBlade)%Orientation(2,:,IElement) + norm_Vector = CPitch*u%InputMarkers(IBlade)%Orientation(1,:,IElement) & + & + SPitch*u%InputMarkers(IBlade)%Orientation(2,:,IElement) - tmpVector = CPitch*u%InputMarkers(IBlade)%Orientation(1,:,IElement) & - + SPitch*u%InputMarkers(IBlade)%Orientation(2,:,IElement) - VNWind = DOT_PRODUCT( tmpVector, VelocityVec ) - VNElement = -1.*DOT_PRODUCT( tmpVector, u%InputMarkers(IBlade)%TranslationVel(:,IElement ) ) + VTTotal = DOT_PRODUCT( tang_Vector, VelocityVec - u%InputMarkers(IBlade)%TranslationVel(:,IElement) ) + VTElement = - DOT_PRODUCT( tang_Vector, u%InputMarkers(IBlade)%TranslationVel(:,IElement) ) + VNElement = - DOT_PRODUCT( norm_Vector, u%InputMarkers(IBlade)%TranslationVel(:,IElement ) ) + + VTWind = DOT_PRODUCT( tang_Vector, VelocityVec) + VNWind = DOT_PRODUCT( norm_Vector, VelocityVec) !------------------------------------------------------------------------------------------- ! Get blade element forces and induced velocity !------------------------------------------------------------------------------------------- - CALL ELEMFRC( p, m, ErrStatLcl, ErrMessLcl, & - AzimuthAngle, rLocal, IElement, IBlade, VelNormalToRotor2, VTTotal, VNWind, & - VNElement, DFN, DFT, PMA, m%NoLoadsCalculated ) + ! --------------------------------------------------------------------------------} + ! --- Setting Element% values: W2, Alpha, A, AP + ! --------------------------------------------------------------------------------{ + ! --- BEM + CALL ELEM_INDUCTIONS( p, m, ErrStatLcl, ErrMessLcl, & + AzimuthAngle, rLocal, IElement, IBlade, VelNormalToRotor2, VTTotal, VNWind, & + VNElement, m%NoLoadsCalculated) + ! Normal and tangential induced velocities + VN_ind = - VNWind * m%Element%A (IElement, IBLADE) + VT_ind = VTTotal * m%Element%AP(IElement, IBLADE) + + ! Cumulative (integrated) induction over the blades + m%InducedVel%SumInfl = m%InducedVel%SumInfl - VN_IND * RLOCAL * p%Blade%DR(IElement) + + ! --- Total flow velocity at the blade element + VN = VN_IND + VNWind + VNElement ! Normal velocity : Indution + Wind + Rel. blade vel + VT = VT_IND + VTTotal ! Tangential velocity : Indution + (Wind + Rel. blade vel) + + PHI = ATAN2( VN, VT) ! Flow angle [rad] + m%Element%ALPHA(IElement,IBlade) = PHI - m%Element%PitNow(IElement,IBlade) ! Angle of attack [rad] + CALL MPI2PI ( m%Element%ALPHA(IElement,IBlade) ) + m%Element%W2(IElement,IBlade) = VN * VN + VT * VT ! Relative velocity norm + + CALL ELEMFRC2( p, m, ErrStatLcl, ErrMessLcl, IElement, IBlade, & + DFN, DFT, PMA, m%NoLoadsCalculated, phi ) CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput' ) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() @@ -1113,7 +1153,6 @@ SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) m%NoLoadsCalculated = .FALSE. - DO IBlade=1,p%NumBl DO IElement=1,p%Element%Nelm y%OutputLoads(IBlade)%Force(:,IElement) = m%StoredForces(:,IElement,IBlade) diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 315d478986..287f17597c 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -209,22 +209,22 @@ MODULE AeroDyn14_Types ! ======================= ! ========= Element ======= TYPE, PUBLIC :: Element - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AP - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ALPHA - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: W2 + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< - [Axial induction factor] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AP !< - [Tangential induction factor] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ALPHA !< - [Angle of attack] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: W2 !< - [Relative velocity norm ] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLD_A_NS REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLD_AP_NS - REAL(ReKi) :: PITNOW + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PITNOW !< - [Current pitch angle - Based on blade orientation (to verify)] END TYPE Element ! ======================= ! ========= ElementParms ======= TYPE, PUBLIC :: ElementParms - INTEGER(IntKi) :: NELM - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TWIST - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RELM - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HLCNST - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TLCNST + INTEGER(IntKi) :: NELM !< - [Number of elements (constant)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TWIST !< - [Airfoil twist angle (constant)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RELM !< - [Radius of element (constant)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HLCNST !< - [Hub loss constant B/2*(r-rh)/rh (constant)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TLCNST !< - [Tip loss constant B/2*(R-r)/R (constant) ] END TYPE ElementParms ! ======================= ! ========= ElOutParms ======= @@ -243,6 +243,7 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PMM REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PITSAV REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReyNum + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Gamma !< - [Circulation along the span, 1/2 c Vrel Cl] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVX REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVY REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVZ @@ -577,14 +578,24 @@ SUBROUTINE AD14_PackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orientation))-1 ) = PACK(InData%Orientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orientation) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TranslationVel))-1 ) = PACK(InData%TranslationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TranslationVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotationVel))-1 ) = PACK(InData%RotationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotationVel) + DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) + ReKiBuf(Re_Xferred) = InData%Position(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Orientation,2), UBOUND(InData%Orientation,2) + DO i1 = LBOUND(InData%Orientation,1), UBOUND(InData%Orientation,1) + ReKiBuf(Re_Xferred) = InData%Orientation(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%TranslationVel,1), UBOUND(InData%TranslationVel,1) + ReKiBuf(Re_Xferred) = InData%TranslationVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RotationVel,1), UBOUND(InData%RotationVel,1) + ReKiBuf(Re_Xferred) = InData%RotationVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackMarker SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -600,12 +611,6 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -624,50 +629,32 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%Position,1) i1_u = UBOUND(OutData%Position,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) + OutData%Position(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%Orientation,1) i1_u = UBOUND(OutData%Orientation,1) i2_l = LBOUND(OutData%Orientation,2) i2_u = UBOUND(OutData%Orientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orientation = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orientation))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orientation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Orientation,2), UBOUND(OutData%Orientation,2) + DO i1 = LBOUND(OutData%Orientation,1), UBOUND(OutData%Orientation,1) + OutData%Orientation(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%TranslationVel,1) i1_u = UBOUND(OutData%TranslationVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TranslationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TranslationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TranslationVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TranslationVel,1), UBOUND(OutData%TranslationVel,1) + OutData%TranslationVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RotationVel,1) i1_u = UBOUND(OutData%RotationVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotationVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotationVel,1), UBOUND(OutData%RotationVel,1) + OutData%RotationVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackMarker SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) @@ -1192,8 +1179,8 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackAeroConfig SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1209,12 +1196,6 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1565,8 +1546,8 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackAeroConfig SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) @@ -1772,8 +1753,12 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AL))-1 ) = PACK(InData%AL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AL) + DO i2 = LBOUND(InData%AL,2), UBOUND(InData%AL,2) + DO i1 = LBOUND(InData%AL,1), UBOUND(InData%AL,1) + ReKiBuf(Re_Xferred) = InData%AL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1791,8 +1776,14 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CD))-1 ) = PACK(InData%CD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CD) + DO i3 = LBOUND(InData%CD,3), UBOUND(InData%CD,3) + DO i2 = LBOUND(InData%CD,2), UBOUND(InData%CD,2) + DO i1 = LBOUND(InData%CD,1), UBOUND(InData%CD,1) + ReKiBuf(Re_Xferred) = InData%CD(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1810,8 +1801,14 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CL))-1 ) = PACK(InData%CL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CL) + DO i3 = LBOUND(InData%CL,3), UBOUND(InData%CL,3) + DO i2 = LBOUND(InData%CL,2), UBOUND(InData%CL,2) + DO i1 = LBOUND(InData%CL,1), UBOUND(InData%CL,1) + ReKiBuf(Re_Xferred) = InData%CL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,13 +1826,19 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CM))-1 ) = PACK(InData%CM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CM) + DO i3 = LBOUND(InData%CM,3), UBOUND(InData%CM,3) + DO i2 = LBOUND(InData%CM,2), UBOUND(InData%CM,2) + DO i1 = LBOUND(InData%CM,1), UBOUND(InData%CM,1) + ReKiBuf(Re_Xferred) = InData%CM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PMC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MulTabLoc + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackAirFoil SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1851,12 +1854,6 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1889,15 +1886,12 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AL)>0) OutData%AL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AL,2), UBOUND(OutData%AL,2) + DO i1 = LBOUND(OutData%AL,1), UBOUND(OutData%AL,1) + OutData%AL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated Int_Xferred = Int_Xferred + 1 @@ -1918,15 +1912,14 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CD)>0) OutData%CD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CD))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CD) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CD,3), UBOUND(OutData%CD,3) + DO i2 = LBOUND(OutData%CD,2), UBOUND(OutData%CD,2) + DO i1 = LBOUND(OutData%CD,1), UBOUND(OutData%CD,1) + OutData%CD(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CL not allocated Int_Xferred = Int_Xferred + 1 @@ -1947,15 +1940,14 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CL)>0) OutData%CL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CL,3), UBOUND(OutData%CL,3) + DO i2 = LBOUND(OutData%CL,2), UBOUND(OutData%CL,2) + DO i1 = LBOUND(OutData%CL,1), UBOUND(OutData%CL,1) + OutData%CL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM not allocated Int_Xferred = Int_Xferred + 1 @@ -1976,20 +1968,19 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CM)>0) OutData%CM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CM) - DEALLOCATE(mask3) - END IF - OutData%PMC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%CM,3), UBOUND(OutData%CM,3) + DO i2 = LBOUND(OutData%CM,2), UBOUND(OutData%CM,2) + DO i1 = LBOUND(OutData%CM,1), UBOUND(OutData%CM,1) + OutData%CM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%PMC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MulTabLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackAirFoil SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -2191,8 +2182,8 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxTable - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxTable + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NTables) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2203,8 +2194,10 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NTables)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTables))-1 ) = PACK(InData%NTables,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTables) + DO i1 = LBOUND(InData%NTables,1), UBOUND(InData%NTables,1) + IntKiBuf(Int_Xferred) = InData%NTables(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NLift) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2216,13 +2209,15 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NLift)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NLift))-1 ) = PACK(InData%NLift,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NLift) + DO i1 = LBOUND(InData%NLift,1), UBOUND(InData%NLift,1) + IntKiBuf(Int_Xferred) = InData%NLift(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumFoil + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2233,8 +2228,10 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NFoil)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NFoil))-1 ) = PACK(InData%NFoil,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NFoil) + DO i1 = LBOUND(InData%NFoil,1), UBOUND(InData%NFoil,1) + IntKiBuf(Int_Xferred) = InData%NFoil(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2249,8 +2246,12 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MulTabMet)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabMet))-1 ) = PACK(InData%MulTabMet,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabMet) + DO i2 = LBOUND(InData%MulTabMet,2), UBOUND(InData%MulTabMet,2) + DO i1 = LBOUND(InData%MulTabMet,1), UBOUND(InData%MulTabMet,1) + ReKiBuf(Re_Xferred) = InData%MulTabMet(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2262,12 +2263,12 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) + DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) DO I = 1, LEN(InData%FoilNm) IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE AD14_PackAirFoilParms @@ -2284,12 +2285,6 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2305,8 +2300,8 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MaxTable = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MaxTable = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2320,15 +2315,10 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NTables)>0) OutData%NTables = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTables))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTables) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NTables,1), UBOUND(OutData%NTables,1) + OutData%NTables(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated Int_Xferred = Int_Xferred + 1 @@ -2343,20 +2333,15 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NLift)>0) OutData%NLift = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NLift))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NLift) - DEALLOCATE(mask1) - END IF - OutData%NumCL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NLift,1), UBOUND(OutData%NLift,1) + OutData%NLift(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NumCL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumFoil = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2370,15 +2355,10 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NFoil)>0) OutData%NFoil = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NFoil))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NFoil) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NFoil,1), UBOUND(OutData%NFoil,1) + OutData%NFoil(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated Int_Xferred = Int_Xferred + 1 @@ -2396,15 +2376,12 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabMet)>0) OutData%MulTabMet = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabMet))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabMet) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MulTabMet,2), UBOUND(OutData%MulTabMet,2) + DO i1 = LBOUND(OutData%MulTabMet,1), UBOUND(OutData%MulTabMet,1) + OutData%MulTabMet(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated Int_Xferred = Int_Xferred + 1 @@ -2419,19 +2396,12 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) + DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) DO I = 1, LEN(OutData%FoilNm) OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE AD14_UnPackAirFoilParms @@ -3714,8 +3684,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ADOT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ADOT))-1 ) = PACK(InData%ADOT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ADOT) + DO i2 = LBOUND(InData%ADOT,2), UBOUND(InData%ADOT,2) + DO i1 = LBOUND(InData%ADOT,1), UBOUND(InData%ADOT,1) + ReKiBuf(Re_Xferred) = InData%ADOT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ADOT1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3730,8 +3704,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ADOT1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ADOT1))-1 ) = PACK(InData%ADOT1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ADOT1) + DO i2 = LBOUND(InData%ADOT1,2), UBOUND(InData%ADOT1,2) + DO i1 = LBOUND(InData%ADOT1,1), UBOUND(InData%ADOT1,1) + ReKiBuf(Re_Xferred) = InData%ADOT1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3746,8 +3724,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFE))-1 ) = PACK(InData%AFE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFE) + DO i2 = LBOUND(InData%AFE,2), UBOUND(InData%AFE,2) + DO i1 = LBOUND(InData%AFE,1), UBOUND(InData%AFE,1) + ReKiBuf(Re_Xferred) = InData%AFE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AFE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3762,11 +3744,15 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFE1))-1 ) = PACK(InData%AFE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFE1) + DO i2 = LBOUND(InData%AFE1,2), UBOUND(InData%AFE1,2) + DO i1 = LBOUND(InData%AFE1,1), UBOUND(InData%AFE1,1) + ReKiBuf(Re_Xferred) = InData%AFE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AN - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AN + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ANE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3780,8 +3766,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANE))-1 ) = PACK(InData%ANE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANE) + DO i2 = LBOUND(InData%ANE,2), UBOUND(InData%ANE,2) + DO i1 = LBOUND(InData%ANE,1), UBOUND(InData%ANE,1) + ReKiBuf(Re_Xferred) = InData%ANE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ANE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3796,8 +3786,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANE1))-1 ) = PACK(InData%ANE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANE1) + DO i2 = LBOUND(InData%ANE1,2), UBOUND(InData%ANE1,2) + DO i1 = LBOUND(InData%ANE1,1), UBOUND(InData%ANE1,1) + ReKiBuf(Re_Xferred) = InData%ANE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3812,8 +3806,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOD))-1 ) = PACK(InData%AOD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOD) + DO i2 = LBOUND(InData%AOD,2), UBOUND(InData%AOD,2) + DO i1 = LBOUND(InData%AOD,1), UBOUND(InData%AOD,1) + ReKiBuf(Re_Xferred) = InData%AOD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3828,8 +3826,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOL))-1 ) = PACK(InData%AOL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOL) + DO i2 = LBOUND(InData%AOL,2), UBOUND(InData%AOL,2) + DO i1 = LBOUND(InData%AOL,1), UBOUND(InData%AOL,1) + ReKiBuf(Re_Xferred) = InData%AOL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3844,8 +3846,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BEDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BEDSEP)-1 ) = TRANSFER(PACK( InData%BEDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%BEDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%BEDSEP) + DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) + DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3860,11 +3866,15 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%OLDSEP)-1 ) = TRANSFER(PACK( InData%OLDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%OLDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%OLDSEP) + DO i2 = LBOUND(InData%OLDSEP,2), UBOUND(InData%OLDSEP,2) + DO i1 = LBOUND(InData%OLDSEP,1), UBOUND(InData%OLDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%OLDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CDO) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3878,15 +3888,19 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CDO)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CDO))-1 ) = PACK(InData%CDO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CDO) + DO i2 = LBOUND(InData%CDO,2), UBOUND(InData%CDO,2) + DO i1 = LBOUND(InData%CDO,1), UBOUND(InData%CDO,1) + ReKiBuf(Re_Xferred) = InData%CDO(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CMI - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CMQ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CN - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CMI + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CMQ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CN + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CNA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3900,13 +3914,17 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNA))-1 ) = PACK(InData%CNA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNA) + DO i2 = LBOUND(InData%CNA,2), UBOUND(InData%CNA,2) + DO i1 = LBOUND(InData%CNA,1), UBOUND(InData%CNA,1) + ReKiBuf(Re_Xferred) = InData%CNA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CNCP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CNIQ - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CNCP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CNIQ + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CNP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3920,8 +3938,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNP))-1 ) = PACK(InData%CNP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNP) + DO i2 = LBOUND(InData%CNP,2), UBOUND(InData%CNP,2) + DO i1 = LBOUND(InData%CNP,1), UBOUND(InData%CNP,1) + ReKiBuf(Re_Xferred) = InData%CNP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3936,8 +3958,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNP1))-1 ) = PACK(InData%CNP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNP1) + DO i2 = LBOUND(InData%CNP1,2), UBOUND(InData%CNP1,2) + DO i1 = LBOUND(InData%CNP1,1), UBOUND(InData%CNP1,1) + ReKiBuf(Re_Xferred) = InData%CNP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3952,8 +3978,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPD))-1 ) = PACK(InData%CNPD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPD) + DO i2 = LBOUND(InData%CNPD,2), UBOUND(InData%CNPD,2) + DO i1 = LBOUND(InData%CNPD,1), UBOUND(InData%CNPD,1) + ReKiBuf(Re_Xferred) = InData%CNPD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPD1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3968,8 +3998,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPD1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPD1))-1 ) = PACK(InData%CNPD1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPD1) + DO i2 = LBOUND(InData%CNPD1,2), UBOUND(InData%CNPD1,2) + DO i1 = LBOUND(InData%CNPD1,1), UBOUND(InData%CNPD1,1) + ReKiBuf(Re_Xferred) = InData%CNPD1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPOT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3984,8 +4018,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPOT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPOT))-1 ) = PACK(InData%CNPOT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPOT) + DO i2 = LBOUND(InData%CNPOT,2), UBOUND(InData%CNPOT,2) + DO i1 = LBOUND(InData%CNPOT,1), UBOUND(InData%CNPOT,1) + ReKiBuf(Re_Xferred) = InData%CNPOT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPOT1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4000,8 +4038,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPOT1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPOT1))-1 ) = PACK(InData%CNPOT1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPOT1) + DO i2 = LBOUND(InData%CNPOT1,2), UBOUND(InData%CNPOT1,2) + DO i1 = LBOUND(InData%CNPOT1,1), UBOUND(InData%CNPOT1,1) + ReKiBuf(Re_Xferred) = InData%CNPOT1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4016,8 +4058,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNS))-1 ) = PACK(InData%CNS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNS) + DO i2 = LBOUND(InData%CNS,2), UBOUND(InData%CNS,2) + DO i1 = LBOUND(InData%CNS,1), UBOUND(InData%CNS,1) + ReKiBuf(Re_Xferred) = InData%CNS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNSL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4032,8 +4078,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNSL))-1 ) = PACK(InData%CNSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNSL) + DO i2 = LBOUND(InData%CNSL,2), UBOUND(InData%CNSL,2) + DO i1 = LBOUND(InData%CNSL,1), UBOUND(InData%CNSL,1) + ReKiBuf(Re_Xferred) = InData%CNSL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4048,8 +4098,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNV))-1 ) = PACK(InData%CNV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNV) + DO i2 = LBOUND(InData%CNV,2), UBOUND(InData%CNV,2) + DO i1 = LBOUND(InData%CNV,1), UBOUND(InData%CNV,1) + ReKiBuf(Re_Xferred) = InData%CNV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CVN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4064,8 +4118,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CVN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CVN))-1 ) = PACK(InData%CVN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CVN) + DO i2 = LBOUND(InData%CVN,2), UBOUND(InData%CVN,2) + DO i1 = LBOUND(InData%CVN,1), UBOUND(InData%CVN,1) + ReKiBuf(Re_Xferred) = InData%CVN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CVN1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4080,8 +4138,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CVN1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CVN1))-1 ) = PACK(InData%CVN1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CVN1) + DO i2 = LBOUND(InData%CVN1,2), UBOUND(InData%CVN1,2) + DO i1 = LBOUND(InData%CVN1,1), UBOUND(InData%CVN1,1) + ReKiBuf(Re_Xferred) = InData%CVN1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4096,8 +4158,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DF))-1 ) = PACK(InData%DF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DF) + DO i2 = LBOUND(InData%DF,2), UBOUND(InData%DF,2) + DO i1 = LBOUND(InData%DF,1), UBOUND(InData%DF,1) + ReKiBuf(Re_Xferred) = InData%DF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFAFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4112,8 +4178,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFAFE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFAFE))-1 ) = PACK(InData%DFAFE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFAFE) + DO i2 = LBOUND(InData%DFAFE,2), UBOUND(InData%DFAFE,2) + DO i1 = LBOUND(InData%DFAFE,1), UBOUND(InData%DFAFE,1) + ReKiBuf(Re_Xferred) = InData%DFAFE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFAFE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4128,8 +4198,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFAFE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFAFE1))-1 ) = PACK(InData%DFAFE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFAFE1) + DO i2 = LBOUND(InData%DFAFE1,2), UBOUND(InData%DFAFE1,2) + DO i1 = LBOUND(InData%DFAFE1,1), UBOUND(InData%DFAFE1,1) + ReKiBuf(Re_Xferred) = InData%DFAFE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4144,8 +4218,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFC))-1 ) = PACK(InData%DFC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFC) + DO i2 = LBOUND(InData%DFC,2), UBOUND(InData%DFC,2) + DO i1 = LBOUND(InData%DFC,1), UBOUND(InData%DFC,1) + ReKiBuf(Re_Xferred) = InData%DFC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4160,8 +4238,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DN))-1 ) = PACK(InData%DN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DN) + DO i2 = LBOUND(InData%DN,2), UBOUND(InData%DN,2) + DO i1 = LBOUND(InData%DN,1), UBOUND(InData%DN,1) + ReKiBuf(Re_Xferred) = InData%DN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DPP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4176,8 +4258,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DPP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DPP))-1 ) = PACK(InData%DPP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DPP) + DO i2 = LBOUND(InData%DPP,2), UBOUND(InData%DPP,2) + DO i1 = LBOUND(InData%DPP,1), UBOUND(InData%DPP,1) + ReKiBuf(Re_Xferred) = InData%DPP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4192,8 +4278,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQ))-1 ) = PACK(InData%DQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQ) + DO i2 = LBOUND(InData%DQ,2), UBOUND(InData%DQ,2) + DO i1 = LBOUND(InData%DQ,1), UBOUND(InData%DQ,1) + ReKiBuf(Re_Xferred) = InData%DQ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4208,8 +4298,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQP))-1 ) = PACK(InData%DQP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQP) + DO i2 = LBOUND(InData%DQP,2), UBOUND(InData%DQP,2) + DO i1 = LBOUND(InData%DQP,1), UBOUND(InData%DQP,1) + ReKiBuf(Re_Xferred) = InData%DQP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4224,17 +4318,21 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQP1))-1 ) = PACK(InData%DQP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQP1) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FK - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FPC - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%DQP1,2), UBOUND(InData%DQP1,2) + DO i1 = LBOUND(InData%DQP1,1), UBOUND(InData%DQP1,1) + ReKiBuf(Re_Xferred) = InData%DQP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%DS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FK + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FPC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FSP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4248,8 +4346,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSP))-1 ) = PACK(InData%FSP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSP) + DO i2 = LBOUND(InData%FSP,2), UBOUND(InData%FSP,2) + DO i1 = LBOUND(InData%FSP,1), UBOUND(InData%FSP,1) + ReKiBuf(Re_Xferred) = InData%FSP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4264,8 +4366,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSP1))-1 ) = PACK(InData%FSP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSP1) + DO i2 = LBOUND(InData%FSP1,2), UBOUND(InData%FSP1,2) + DO i1 = LBOUND(InData%FSP1,1), UBOUND(InData%FSP1,1) + ReKiBuf(Re_Xferred) = InData%FSP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSPC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4280,8 +4386,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSPC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSPC))-1 ) = PACK(InData%FSPC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSPC) + DO i2 = LBOUND(InData%FSPC,2), UBOUND(InData%FSPC,2) + DO i1 = LBOUND(InData%FSPC,1), UBOUND(InData%FSPC,1) + ReKiBuf(Re_Xferred) = InData%FSPC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSPC1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4296,8 +4406,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSPC1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSPC1))-1 ) = PACK(InData%FSPC1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSPC1) + DO i2 = LBOUND(InData%FSPC1,2), UBOUND(InData%FSPC1,2) + DO i1 = LBOUND(InData%FSPC1,1), UBOUND(InData%FSPC1,1) + ReKiBuf(Re_Xferred) = InData%FSPC1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4315,8 +4429,14 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTB))-1 ) = PACK(InData%FTB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTB) + DO i3 = LBOUND(InData%FTB,3), UBOUND(InData%FTB,3) + DO i2 = LBOUND(InData%FTB,2), UBOUND(InData%FTB,2) + DO i1 = LBOUND(InData%FTB,1), UBOUND(InData%FTB,1) + ReKiBuf(Re_Xferred) = InData%FTB(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTBC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4334,8 +4454,14 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTBC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTBC))-1 ) = PACK(InData%FTBC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTBC) + DO i3 = LBOUND(InData%FTBC,3), UBOUND(InData%FTBC,3) + DO i2 = LBOUND(InData%FTBC,2), UBOUND(InData%FTBC,2) + DO i1 = LBOUND(InData%FTBC,1), UBOUND(InData%FTBC,1) + ReKiBuf(Re_Xferred) = InData%FTBC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDCNV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4350,8 +4476,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDCNV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDCNV))-1 ) = PACK(InData%OLDCNV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDCNV) + DO i2 = LBOUND(InData%OLDCNV,2), UBOUND(InData%OLDCNV,2) + DO i1 = LBOUND(InData%OLDCNV,1), UBOUND(InData%OLDCNV,1) + ReKiBuf(Re_Xferred) = InData%OLDCNV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4366,8 +4496,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDF))-1 ) = PACK(InData%OLDDF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDF) + DO i2 = LBOUND(InData%OLDDF,2), UBOUND(InData%OLDDF,2) + DO i1 = LBOUND(InData%OLDDF,1), UBOUND(InData%OLDDF,1) + ReKiBuf(Re_Xferred) = InData%OLDDF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDFC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4382,8 +4516,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDFC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDFC))-1 ) = PACK(InData%OLDDFC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDFC) + DO i2 = LBOUND(InData%OLDDFC,2), UBOUND(InData%OLDDFC,2) + DO i1 = LBOUND(InData%OLDDFC,1), UBOUND(InData%OLDDFC,1) + ReKiBuf(Re_Xferred) = InData%OLDDFC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4398,8 +4536,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDN))-1 ) = PACK(InData%OLDDN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDN) + DO i2 = LBOUND(InData%OLDDN,2), UBOUND(InData%OLDDN,2) + DO i1 = LBOUND(InData%OLDDN,1), UBOUND(InData%OLDDN,1) + ReKiBuf(Re_Xferred) = InData%OLDDN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDPP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4414,8 +4556,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDPP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDPP))-1 ) = PACK(InData%OLDDPP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDPP) + DO i2 = LBOUND(InData%OLDDPP,2), UBOUND(InData%OLDDPP,2) + DO i1 = LBOUND(InData%OLDDPP,1), UBOUND(InData%OLDDPP,1) + ReKiBuf(Re_Xferred) = InData%OLDDPP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4430,8 +4576,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDQ))-1 ) = PACK(InData%OLDDQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDQ) + DO i2 = LBOUND(InData%OLDDQ,2), UBOUND(InData%OLDDQ,2) + DO i1 = LBOUND(InData%OLDDQ,1), UBOUND(InData%OLDDQ,1) + ReKiBuf(Re_Xferred) = InData%OLDDQ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDTAU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4446,8 +4596,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDTAU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDTAU))-1 ) = PACK(InData%OLDTAU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDTAU) + DO i2 = LBOUND(InData%OLDTAU,2), UBOUND(InData%OLDTAU,2) + DO i1 = LBOUND(InData%OLDTAU,1), UBOUND(InData%OLDTAU,1) + ReKiBuf(Re_Xferred) = InData%OLDTAU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDXN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4462,8 +4616,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDXN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDXN))-1 ) = PACK(InData%OLDXN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDXN) + DO i2 = LBOUND(InData%OLDXN,2), UBOUND(InData%OLDXN,2) + DO i1 = LBOUND(InData%OLDXN,1), UBOUND(InData%OLDXN,1) + ReKiBuf(Re_Xferred) = InData%OLDXN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDYN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4478,8 +4636,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDYN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDYN))-1 ) = PACK(InData%OLDYN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDYN) + DO i2 = LBOUND(InData%OLDYN,2), UBOUND(InData%OLDYN,2) + DO i1 = LBOUND(InData%OLDYN,1), UBOUND(InData%OLDYN,1) + ReKiBuf(Re_Xferred) = InData%OLDYN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4494,8 +4656,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%QX))-1 ) = PACK(InData%QX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%QX) + DO i2 = LBOUND(InData%QX,2), UBOUND(InData%QX,2) + DO i1 = LBOUND(InData%QX,1), UBOUND(InData%QX,1) + ReKiBuf(Re_Xferred) = InData%QX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QX1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4510,8 +4676,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QX1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%QX1))-1 ) = PACK(InData%QX1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%QX1) + DO i2 = LBOUND(InData%QX1,2), UBOUND(InData%QX1,2) + DO i1 = LBOUND(InData%QX1,1), UBOUND(InData%QX1,1) + ReKiBuf(Re_Xferred) = InData%QX1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TAU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4526,8 +4696,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TAU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TAU))-1 ) = PACK(InData%TAU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TAU) + DO i2 = LBOUND(InData%TAU,2), UBOUND(InData%TAU,2) + DO i1 = LBOUND(InData%TAU,1), UBOUND(InData%TAU,1) + ReKiBuf(Re_Xferred) = InData%TAU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%XN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4542,8 +4716,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XN))-1 ) = PACK(InData%XN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XN) + DO i2 = LBOUND(InData%XN,2), UBOUND(InData%XN,2) + DO i1 = LBOUND(InData%XN,1), UBOUND(InData%XN,1) + ReKiBuf(Re_Xferred) = InData%XN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%YN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4558,13 +4736,17 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%YN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%YN))-1 ) = PACK(InData%YN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%YN) + DO i2 = LBOUND(InData%YN,2), UBOUND(InData%YN,2) + DO i1 = LBOUND(InData%YN,1), UBOUND(InData%YN,1) + ReKiBuf(Re_Xferred) = InData%YN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SHIFT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%VOR , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SHIFT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VOR, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackBeddoes SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4580,12 +4762,6 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4618,15 +4794,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ADOT)>0) OutData%ADOT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ADOT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ADOT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ADOT,2), UBOUND(OutData%ADOT,2) + DO i1 = LBOUND(OutData%ADOT,1), UBOUND(OutData%ADOT,1) + OutData%ADOT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4644,15 +4817,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ADOT1)>0) OutData%ADOT1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ADOT1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ADOT1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ADOT1,2), UBOUND(OutData%ADOT1,2) + DO i1 = LBOUND(OutData%ADOT1,1), UBOUND(OutData%ADOT1,1) + OutData%ADOT1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE not allocated Int_Xferred = Int_Xferred + 1 @@ -4670,15 +4840,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFE)>0) OutData%AFE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFE,2), UBOUND(OutData%AFE,2) + DO i1 = LBOUND(OutData%AFE,1), UBOUND(OutData%AFE,1) + OutData%AFE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4696,18 +4863,15 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFE1)>0) OutData%AFE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFE1,2), UBOUND(OutData%AFE1,2) + DO i1 = LBOUND(OutData%AFE1,1), UBOUND(OutData%AFE1,1) + OutData%AFE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%AN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4724,15 +4888,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANE)>0) OutData%ANE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANE,2), UBOUND(OutData%ANE,2) + DO i1 = LBOUND(OutData%ANE,1), UBOUND(OutData%ANE,1) + OutData%ANE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4750,15 +4911,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANE1)>0) OutData%ANE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANE1,2), UBOUND(OutData%ANE1,2) + DO i1 = LBOUND(OutData%ANE1,1), UBOUND(OutData%ANE1,1) + OutData%ANE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOD not allocated Int_Xferred = Int_Xferred + 1 @@ -4776,15 +4934,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOD)>0) OutData%AOD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOD,2), UBOUND(OutData%AOD,2) + DO i1 = LBOUND(OutData%AOD,1), UBOUND(OutData%AOD,1) + OutData%AOD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOL not allocated Int_Xferred = Int_Xferred + 1 @@ -4802,15 +4957,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOL)>0) OutData%AOL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOL,2), UBOUND(OutData%AOL,2) + DO i1 = LBOUND(OutData%AOL,1), UBOUND(OutData%AOL,1) + OutData%AOL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4828,15 +4980,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BEDSEP)>0) OutData%BEDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BEDSEP))-1 ), OutData%BEDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BEDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) + DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) + OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4854,18 +5003,15 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDSEP)>0) OutData%OLDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OLDSEP))-1 ), OutData%OLDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%OLDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDSEP,2), UBOUND(OutData%OLDSEP,2) + DO i1 = LBOUND(OutData%OLDSEP,1), UBOUND(OutData%OLDSEP,1) + OutData%OLDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%OLDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%CC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%CC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDO not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4882,22 +5028,19 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CDO)>0) OutData%CDO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CDO))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CDO) - DEALLOCATE(mask2) - END IF - OutData%CMI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CMQ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%CDO,2), UBOUND(OutData%CDO,2) + DO i1 = LBOUND(OutData%CDO,1), UBOUND(OutData%CDO,1) + OutData%CDO(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%CMI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CMQ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4914,20 +5057,17 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNA)>0) OutData%CNA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNA) - DEALLOCATE(mask2) - END IF - OutData%CNCP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CNIQ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%CNA,2), UBOUND(OutData%CNA,2) + DO i1 = LBOUND(OutData%CNA,1), UBOUND(OutData%CNA,1) + OutData%CNA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%CNCP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CNIQ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4944,15 +5084,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNP)>0) OutData%CNP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNP,2), UBOUND(OutData%CNP,2) + DO i1 = LBOUND(OutData%CNP,1), UBOUND(OutData%CNP,1) + OutData%CNP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4970,15 +5107,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNP1)>0) OutData%CNP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNP1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNP1,2), UBOUND(OutData%CNP1,2) + DO i1 = LBOUND(OutData%CNP1,1), UBOUND(OutData%CNP1,1) + OutData%CNP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD not allocated Int_Xferred = Int_Xferred + 1 @@ -4996,15 +5130,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPD)>0) OutData%CNPD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPD,2), UBOUND(OutData%CNPD,2) + DO i1 = LBOUND(OutData%CNPD,1), UBOUND(OutData%CNPD,1) + OutData%CNPD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5022,15 +5153,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPD1)>0) OutData%CNPD1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPD1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPD1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPD1,2), UBOUND(OutData%CNPD1,2) + DO i1 = LBOUND(OutData%CNPD1,1), UBOUND(OutData%CNPD1,1) + OutData%CNPD1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT not allocated Int_Xferred = Int_Xferred + 1 @@ -5048,15 +5176,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPOT)>0) OutData%CNPOT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPOT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPOT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPOT,2), UBOUND(OutData%CNPOT,2) + DO i1 = LBOUND(OutData%CNPOT,1), UBOUND(OutData%CNPOT,1) + OutData%CNPOT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5074,15 +5199,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPOT1)>0) OutData%CNPOT1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPOT1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPOT1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPOT1,2), UBOUND(OutData%CNPOT1,2) + DO i1 = LBOUND(OutData%CNPOT1,1), UBOUND(OutData%CNPOT1,1) + OutData%CNPOT1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNS not allocated Int_Xferred = Int_Xferred + 1 @@ -5100,15 +5222,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNS)>0) OutData%CNS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNS,2), UBOUND(OutData%CNS,2) + DO i1 = LBOUND(OutData%CNS,1), UBOUND(OutData%CNS,1) + OutData%CNS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNSL not allocated Int_Xferred = Int_Xferred + 1 @@ -5126,15 +5245,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNSL)>0) OutData%CNSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNSL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNSL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNSL,2), UBOUND(OutData%CNSL,2) + DO i1 = LBOUND(OutData%CNSL,1), UBOUND(OutData%CNSL,1) + OutData%CNSL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNV not allocated Int_Xferred = Int_Xferred + 1 @@ -5152,15 +5268,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNV)>0) OutData%CNV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNV,2), UBOUND(OutData%CNV,2) + DO i1 = LBOUND(OutData%CNV,1), UBOUND(OutData%CNV,1) + OutData%CNV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN not allocated Int_Xferred = Int_Xferred + 1 @@ -5178,15 +5291,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CVN)>0) OutData%CVN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CVN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CVN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CVN,2), UBOUND(OutData%CVN,2) + DO i1 = LBOUND(OutData%CVN,1), UBOUND(OutData%CVN,1) + OutData%CVN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5204,15 +5314,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CVN1)>0) OutData%CVN1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CVN1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CVN1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CVN1,2), UBOUND(OutData%CVN1,2) + DO i1 = LBOUND(OutData%CVN1,1), UBOUND(OutData%CVN1,1) + OutData%CVN1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DF not allocated Int_Xferred = Int_Xferred + 1 @@ -5230,15 +5337,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DF)>0) OutData%DF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DF,2), UBOUND(OutData%DF,2) + DO i1 = LBOUND(OutData%DF,1), UBOUND(OutData%DF,1) + OutData%DF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE not allocated Int_Xferred = Int_Xferred + 1 @@ -5256,15 +5360,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFAFE)>0) OutData%DFAFE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFAFE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFAFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFAFE,2), UBOUND(OutData%DFAFE,2) + DO i1 = LBOUND(OutData%DFAFE,1), UBOUND(OutData%DFAFE,1) + OutData%DFAFE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5282,15 +5383,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFAFE1)>0) OutData%DFAFE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFAFE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFAFE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFAFE1,2), UBOUND(OutData%DFAFE1,2) + DO i1 = LBOUND(OutData%DFAFE1,1), UBOUND(OutData%DFAFE1,1) + OutData%DFAFE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFC not allocated Int_Xferred = Int_Xferred + 1 @@ -5308,15 +5406,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFC)>0) OutData%DFC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFC,2), UBOUND(OutData%DFC,2) + DO i1 = LBOUND(OutData%DFC,1), UBOUND(OutData%DFC,1) + OutData%DFC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DN not allocated Int_Xferred = Int_Xferred + 1 @@ -5334,15 +5429,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DN)>0) OutData%DN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DN,2), UBOUND(OutData%DN,2) + DO i1 = LBOUND(OutData%DN,1), UBOUND(OutData%DN,1) + OutData%DN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DPP not allocated Int_Xferred = Int_Xferred + 1 @@ -5360,15 +5452,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DPP)>0) OutData%DPP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DPP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DPP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DPP,2), UBOUND(OutData%DPP,2) + DO i1 = LBOUND(OutData%DPP,1), UBOUND(OutData%DPP,1) + OutData%DPP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQ not allocated Int_Xferred = Int_Xferred + 1 @@ -5386,15 +5475,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQ)>0) OutData%DQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DQ,2), UBOUND(OutData%DQ,2) + DO i1 = LBOUND(OutData%DQ,1), UBOUND(OutData%DQ,1) + OutData%DQ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP not allocated Int_Xferred = Int_Xferred + 1 @@ -5412,15 +5498,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQP)>0) OutData%DQP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DQP,2), UBOUND(OutData%DQP,2) + DO i1 = LBOUND(OutData%DQP,1), UBOUND(OutData%DQP,1) + OutData%DQP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5438,24 +5521,21 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQP1)>0) OutData%DQP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQP1) - DEALLOCATE(mask2) - END IF - OutData%DS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FK = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FPC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%DQP1,2), UBOUND(OutData%DQP1,2) + DO i1 = LBOUND(OutData%DQP1,1), UBOUND(OutData%DQP1,1) + OutData%DQP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%DS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FK = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FPC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5472,15 +5552,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSP)>0) OutData%FSP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSP,2), UBOUND(OutData%FSP,2) + DO i1 = LBOUND(OutData%FSP,1), UBOUND(OutData%FSP,1) + OutData%FSP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5498,15 +5575,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSP1)>0) OutData%FSP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSP1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSP1,2), UBOUND(OutData%FSP1,2) + DO i1 = LBOUND(OutData%FSP1,1), UBOUND(OutData%FSP1,1) + OutData%FSP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC not allocated Int_Xferred = Int_Xferred + 1 @@ -5524,15 +5598,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSPC)>0) OutData%FSPC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSPC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSPC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSPC,2), UBOUND(OutData%FSPC,2) + DO i1 = LBOUND(OutData%FSPC,1), UBOUND(OutData%FSPC,1) + OutData%FSPC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5550,15 +5621,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSPC1)>0) OutData%FSPC1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSPC1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSPC1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSPC1,2), UBOUND(OutData%FSPC1,2) + DO i1 = LBOUND(OutData%FSPC1,1), UBOUND(OutData%FSPC1,1) + OutData%FSPC1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTB not allocated Int_Xferred = Int_Xferred + 1 @@ -5579,15 +5647,14 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FTB)>0) OutData%FTB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTB))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTB) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FTB,3), UBOUND(OutData%FTB,3) + DO i2 = LBOUND(OutData%FTB,2), UBOUND(OutData%FTB,2) + DO i1 = LBOUND(OutData%FTB,1), UBOUND(OutData%FTB,1) + OutData%FTB(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTBC not allocated Int_Xferred = Int_Xferred + 1 @@ -5608,15 +5675,14 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FTBC)>0) OutData%FTBC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTBC))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTBC) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FTBC,3), UBOUND(OutData%FTBC,3) + DO i2 = LBOUND(OutData%FTBC,2), UBOUND(OutData%FTBC,2) + DO i1 = LBOUND(OutData%FTBC,1), UBOUND(OutData%FTBC,1) + OutData%FTBC(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDCNV not allocated Int_Xferred = Int_Xferred + 1 @@ -5634,15 +5700,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDCNV)>0) OutData%OLDCNV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDCNV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDCNV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDCNV,2), UBOUND(OutData%OLDCNV,2) + DO i1 = LBOUND(OutData%OLDCNV,1), UBOUND(OutData%OLDCNV,1) + OutData%OLDCNV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDF not allocated Int_Xferred = Int_Xferred + 1 @@ -5660,15 +5723,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDF)>0) OutData%OLDDF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDF,2), UBOUND(OutData%OLDDF,2) + DO i1 = LBOUND(OutData%OLDDF,1), UBOUND(OutData%OLDDF,1) + OutData%OLDDF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDFC not allocated Int_Xferred = Int_Xferred + 1 @@ -5686,15 +5746,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDFC)>0) OutData%OLDDFC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDFC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDFC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDFC,2), UBOUND(OutData%OLDDFC,2) + DO i1 = LBOUND(OutData%OLDDFC,1), UBOUND(OutData%OLDDFC,1) + OutData%OLDDFC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDN not allocated Int_Xferred = Int_Xferred + 1 @@ -5712,15 +5769,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDN)>0) OutData%OLDDN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDN,2), UBOUND(OutData%OLDDN,2) + DO i1 = LBOUND(OutData%OLDDN,1), UBOUND(OutData%OLDDN,1) + OutData%OLDDN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDPP not allocated Int_Xferred = Int_Xferred + 1 @@ -5738,15 +5792,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDPP)>0) OutData%OLDDPP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDPP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDPP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDPP,2), UBOUND(OutData%OLDDPP,2) + DO i1 = LBOUND(OutData%OLDDPP,1), UBOUND(OutData%OLDDPP,1) + OutData%OLDDPP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDQ not allocated Int_Xferred = Int_Xferred + 1 @@ -5764,15 +5815,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDQ)>0) OutData%OLDDQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDQ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDQ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDQ,2), UBOUND(OutData%OLDDQ,2) + DO i1 = LBOUND(OutData%OLDDQ,1), UBOUND(OutData%OLDDQ,1) + OutData%OLDDQ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDTAU not allocated Int_Xferred = Int_Xferred + 1 @@ -5790,15 +5838,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDTAU)>0) OutData%OLDTAU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDTAU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDTAU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDTAU,2), UBOUND(OutData%OLDTAU,2) + DO i1 = LBOUND(OutData%OLDTAU,1), UBOUND(OutData%OLDTAU,1) + OutData%OLDTAU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDXN not allocated Int_Xferred = Int_Xferred + 1 @@ -5816,15 +5861,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDXN)>0) OutData%OLDXN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDXN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDXN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDXN,2), UBOUND(OutData%OLDXN,2) + DO i1 = LBOUND(OutData%OLDXN,1), UBOUND(OutData%OLDXN,1) + OutData%OLDXN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDYN not allocated Int_Xferred = Int_Xferred + 1 @@ -5842,15 +5884,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDYN)>0) OutData%OLDYN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDYN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDYN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDYN,2), UBOUND(OutData%OLDYN,2) + DO i1 = LBOUND(OutData%OLDYN,1), UBOUND(OutData%OLDYN,1) + OutData%OLDYN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX not allocated Int_Xferred = Int_Xferred + 1 @@ -5868,15 +5907,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QX)>0) OutData%QX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%QX))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%QX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QX,2), UBOUND(OutData%QX,2) + DO i1 = LBOUND(OutData%QX,1), UBOUND(OutData%QX,1) + OutData%QX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5894,15 +5930,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QX1)>0) OutData%QX1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%QX1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%QX1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QX1,2), UBOUND(OutData%QX1,2) + DO i1 = LBOUND(OutData%QX1,1), UBOUND(OutData%QX1,1) + OutData%QX1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TAU not allocated Int_Xferred = Int_Xferred + 1 @@ -5920,15 +5953,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TAU)>0) OutData%TAU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TAU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TAU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TAU,2), UBOUND(OutData%TAU,2) + DO i1 = LBOUND(OutData%TAU,1), UBOUND(OutData%TAU,1) + OutData%TAU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XN not allocated Int_Xferred = Int_Xferred + 1 @@ -5946,15 +5976,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XN)>0) OutData%XN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XN,2), UBOUND(OutData%XN,2) + DO i1 = LBOUND(OutData%XN,1), UBOUND(OutData%XN,1) + OutData%XN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YN not allocated Int_Xferred = Int_Xferred + 1 @@ -5972,20 +5999,17 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%YN)>0) OutData%YN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%YN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%YN) - DEALLOCATE(mask2) - END IF - OutData%SHIFT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%VOR = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%YN,2), UBOUND(OutData%YN,2) + DO i1 = LBOUND(OutData%YN,1), UBOUND(OutData%YN,1) + OutData%YN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%SHIFT = TRANSFER(IntKiBuf(Int_Xferred), OutData%SHIFT) + Int_Xferred = Int_Xferred + 1 + OutData%VOR = TRANSFER(IntKiBuf(Int_Xferred), OutData%VOR) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackBeddoes SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -6087,16 +6111,16 @@ SUBROUTINE AD14_PackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TVL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TVL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackBeddoesParms SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6112,12 +6136,6 @@ SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackBeddoesParms' @@ -6131,16 +6149,16 @@ SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TVL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TVL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackBeddoesParms SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -6287,8 +6305,10 @@ SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6300,13 +6320,15 @@ SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DR))-1 ) = PACK(InData%DR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DR) + DO i1 = LBOUND(InData%DR,1), UBOUND(InData%DR,1) + ReKiBuf(Re_Xferred) = InData%DR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackBladeParms SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6322,12 +6344,6 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6355,15 +6371,10 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DR not allocated Int_Xferred = Int_Xferred + 1 @@ -6378,20 +6389,15 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DR)>0) OutData%DR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DR) - DEALLOCATE(mask1) - END IF - OutData%R = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%DR,1), UBOUND(OutData%DR,1) + OutData%DR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackBladeParms SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) @@ -6582,26 +6588,42 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dAlph_dt))-1 ) = PACK(InData%dAlph_dt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dAlph_dt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dBeta_dt))-1 ) = PACK(InData%dBeta_dt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dBeta_dt) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTO - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%old_Alph))-1 ) = PACK(InData%old_Alph,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%old_Alph) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%old_Beta))-1 ) = PACK(InData%old_Beta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%old_Beta) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%old_LmdM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%oldKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLqC))-1 ) = PACK(InData%PhiLqC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLqC) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLqS))-1 ) = PACK(InData%PhiLqS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLqS) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pzero - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%dAlph_dt,2), UBOUND(InData%dAlph_dt,2) + DO i1 = LBOUND(InData%dAlph_dt,1), UBOUND(InData%dAlph_dt,1) + ReKiBuf(Re_Xferred) = InData%dAlph_dt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%dBeta_dt,2), UBOUND(InData%dBeta_dt,2) + DO i1 = LBOUND(InData%dBeta_dt,1), UBOUND(InData%dBeta_dt,1) + ReKiBuf(Re_Xferred) = InData%dBeta_dt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%DTO + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%old_Alph,1), UBOUND(InData%old_Alph,1) + ReKiBuf(Re_Xferred) = InData%old_Alph(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%old_Beta,1), UBOUND(InData%old_Beta,1) + ReKiBuf(Re_Xferred) = InData%old_Beta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%old_LmdM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%oldKai + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PhiLqC,1), UBOUND(InData%PhiLqC,1) + ReKiBuf(Re_Xferred) = InData%PhiLqC(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PhiLqS,1), UBOUND(InData%PhiLqS,1) + ReKiBuf(Re_Xferred) = InData%PhiLqS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Pzero + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RMC_SAVE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6618,8 +6640,14 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RMC_SAVE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMC_SAVE))-1 ) = PACK(InData%RMC_SAVE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMC_SAVE) + DO i3 = LBOUND(InData%RMC_SAVE,3), UBOUND(InData%RMC_SAVE,3) + DO i2 = LBOUND(InData%RMC_SAVE,2), UBOUND(InData%RMC_SAVE,2) + DO i1 = LBOUND(InData%RMC_SAVE,1), UBOUND(InData%RMC_SAVE,1) + ReKiBuf(Re_Xferred) = InData%RMC_SAVE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RMS_SAVE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6637,37 +6665,71 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RMS_SAVE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMS_SAVE))-1 ) = PACK(InData%RMS_SAVE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMS_SAVE) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%totalInf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Vparam - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Vtotal - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xAlpha))-1 ) = PACK(InData%xAlpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xAlpha) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xBeta))-1 ) = PACK(InData%xBeta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xBeta) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%xKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%XLAMBDA_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xLcos))-1 ) = PACK(InData%xLcos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xLcos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xLsin))-1 ) = PACK(InData%xLsin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xLsin) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MminR))-1 ) = PACK(InData%MminR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MminR) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MminusR))-1 ) = PACK(InData%MminusR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MminusR) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MplusR))-1 ) = PACK(InData%MplusR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MplusR) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GAMMA))-1 ) = PACK(InData%GAMMA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GAMMA) + DO i3 = LBOUND(InData%RMS_SAVE,3), UBOUND(InData%RMS_SAVE,3) + DO i2 = LBOUND(InData%RMS_SAVE,2), UBOUND(InData%RMS_SAVE,2) + DO i1 = LBOUND(InData%RMS_SAVE,1), UBOUND(InData%RMS_SAVE,1) + ReKiBuf(Re_Xferred) = InData%RMS_SAVE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TipSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%totalInf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Vparam + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Vtotal + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%xAlpha,1), UBOUND(InData%xAlpha,1) + ReKiBuf(Re_Xferred) = InData%xAlpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%xBeta,1), UBOUND(InData%xBeta,1) + ReKiBuf(Re_Xferred) = InData%xBeta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%xKai + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%XLAMBDA_M + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%xLcos,2), UBOUND(InData%xLcos,2) + DO i1 = LBOUND(InData%xLcos,1), UBOUND(InData%xLcos,1) + ReKiBuf(Re_Xferred) = InData%xLcos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%xLsin,2), UBOUND(InData%xLsin,2) + DO i1 = LBOUND(InData%xLsin,1), UBOUND(InData%xLsin,1) + ReKiBuf(Re_Xferred) = InData%xLsin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MminR,2), UBOUND(InData%MminR,2) + DO i1 = LBOUND(InData%MminR,1), UBOUND(InData%MminR,1) + IntKiBuf(Int_Xferred) = InData%MminR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MminusR,2), UBOUND(InData%MminusR,2) + DO i1 = LBOUND(InData%MminusR,1), UBOUND(InData%MminusR,1) + IntKiBuf(Int_Xferred) = InData%MminusR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MplusR,2), UBOUND(InData%MplusR,2) + DO i1 = LBOUND(InData%MplusR,1), UBOUND(InData%MplusR,1) + IntKiBuf(Int_Xferred) = InData%MplusR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%GAMMA,2), UBOUND(InData%GAMMA,2) + DO i1 = LBOUND(InData%GAMMA,1), UBOUND(InData%GAMMA,1) + ReKiBuf(Re_Xferred) = InData%GAMMA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_PackDynInflow SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6683,12 +6745,6 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -6709,80 +6765,54 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E i1_u = UBOUND(OutData%dAlph_dt,1) i2_l = LBOUND(OutData%dAlph_dt,2) i2_u = UBOUND(OutData%dAlph_dt,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%dAlph_dt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dAlph_dt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dAlph_dt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%dAlph_dt,2), UBOUND(OutData%dAlph_dt,2) + DO i1 = LBOUND(OutData%dAlph_dt,1), UBOUND(OutData%dAlph_dt,1) + OutData%dAlph_dt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%dBeta_dt,1) i1_u = UBOUND(OutData%dBeta_dt,1) i2_l = LBOUND(OutData%dBeta_dt,2) i2_u = UBOUND(OutData%dBeta_dt,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%dBeta_dt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dBeta_dt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dBeta_dt) - DEALLOCATE(mask2) - OutData%DTO = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%dBeta_dt,2), UBOUND(OutData%dBeta_dt,2) + DO i1 = LBOUND(OutData%dBeta_dt,1), UBOUND(OutData%dBeta_dt,1) + OutData%dBeta_dt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%DTO = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%old_Alph,1) i1_u = UBOUND(OutData%old_Alph,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%old_Alph = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%old_Alph))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%old_Alph) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%old_Alph,1), UBOUND(OutData%old_Alph,1) + OutData%old_Alph(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%old_Beta,1) i1_u = UBOUND(OutData%old_Beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%old_Beta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%old_Beta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%old_Beta) - DEALLOCATE(mask1) - OutData%old_LmdM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%oldKai = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%old_Beta,1), UBOUND(OutData%old_Beta,1) + OutData%old_Beta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%old_LmdM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%oldKai = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%PhiLqC,1) i1_u = UBOUND(OutData%PhiLqC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PhiLqC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLqC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLqC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PhiLqC,1), UBOUND(OutData%PhiLqC,1) + OutData%PhiLqC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PhiLqS,1) i1_u = UBOUND(OutData%PhiLqS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PhiLqS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLqS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLqS) - DEALLOCATE(mask1) - OutData%Pzero = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PhiLqS,1), UBOUND(OutData%PhiLqS,1) + OutData%PhiLqS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Pzero = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMC_SAVE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6802,15 +6832,14 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RMC_SAVE)>0) OutData%RMC_SAVE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMC_SAVE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMC_SAVE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RMC_SAVE,3), UBOUND(OutData%RMC_SAVE,3) + DO i2 = LBOUND(OutData%RMC_SAVE,2), UBOUND(OutData%RMC_SAVE,2) + DO i1 = LBOUND(OutData%RMC_SAVE,1), UBOUND(OutData%RMC_SAVE,1) + OutData%RMC_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMS_SAVE not allocated Int_Xferred = Int_Xferred + 1 @@ -6831,128 +6860,99 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RMS_SAVE)>0) OutData%RMS_SAVE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMS_SAVE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMS_SAVE) - DEALLOCATE(mask3) - END IF - OutData%TipSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%totalInf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Vparam = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Vtotal = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%RMS_SAVE,3), UBOUND(OutData%RMS_SAVE,3) + DO i2 = LBOUND(OutData%RMS_SAVE,2), UBOUND(OutData%RMS_SAVE,2) + DO i1 = LBOUND(OutData%RMS_SAVE,1), UBOUND(OutData%RMS_SAVE,1) + OutData%RMS_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%TipSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%totalInf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Vparam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Vtotal = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%xAlpha,1) i1_u = UBOUND(OutData%xAlpha,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xAlpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xAlpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xAlpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xAlpha,1), UBOUND(OutData%xAlpha,1) + OutData%xAlpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%xBeta,1) i1_u = UBOUND(OutData%xBeta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xBeta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xBeta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xBeta) - DEALLOCATE(mask1) - OutData%xKai = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%XLAMBDA_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%xBeta,1), UBOUND(OutData%xBeta,1) + OutData%xBeta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%xKai = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%XLAMBDA_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%xLcos,1) i1_u = UBOUND(OutData%xLcos,1) i2_l = LBOUND(OutData%xLcos,2) i2_u = UBOUND(OutData%xLcos,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%xLcos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xLcos))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xLcos) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xLcos,2), UBOUND(OutData%xLcos,2) + DO i1 = LBOUND(OutData%xLcos,1), UBOUND(OutData%xLcos,1) + OutData%xLcos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%xLsin,1) i1_u = UBOUND(OutData%xLsin,1) i2_l = LBOUND(OutData%xLsin,2) i2_u = UBOUND(OutData%xLsin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%xLsin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xLsin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xLsin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xLsin,2), UBOUND(OutData%xLsin,2) + DO i1 = LBOUND(OutData%xLsin,1), UBOUND(OutData%xLsin,1) + OutData%xLsin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MminR,1) i1_u = UBOUND(OutData%MminR,1) i2_l = LBOUND(OutData%MminR,2) i2_u = UBOUND(OutData%MminR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MminR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MminR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MminR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MminR,2), UBOUND(OutData%MminR,2) + DO i1 = LBOUND(OutData%MminR,1), UBOUND(OutData%MminR,1) + OutData%MminR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MminusR,1) i1_u = UBOUND(OutData%MminusR,1) i2_l = LBOUND(OutData%MminusR,2) i2_u = UBOUND(OutData%MminusR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MminusR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MminusR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MminusR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MminusR,2), UBOUND(OutData%MminusR,2) + DO i1 = LBOUND(OutData%MminusR,1), UBOUND(OutData%MminusR,1) + OutData%MminusR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MplusR,1) i1_u = UBOUND(OutData%MplusR,1) i2_l = LBOUND(OutData%MplusR,2) i2_u = UBOUND(OutData%MplusR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MplusR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MplusR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MplusR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MplusR,2), UBOUND(OutData%MplusR,2) + DO i1 = LBOUND(OutData%MplusR,1), UBOUND(OutData%MplusR,1) + OutData%MplusR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%GAMMA,1) i1_u = UBOUND(OutData%GAMMA,1) i2_l = LBOUND(OutData%GAMMA,2) i2_u = UBOUND(OutData%GAMMA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GAMMA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GAMMA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GAMMA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GAMMA,2), UBOUND(OutData%GAMMA,2) + DO i1 = LBOUND(OutData%GAMMA,1), UBOUND(OutData%GAMMA,1) + OutData%GAMMA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_UnPackDynInflow SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -7049,10 +7049,12 @@ SUBROUTINE AD14_PackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MAXINFLO - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xMinv))-1 ) = PACK(InData%xMinv,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xMinv) + IntKiBuf(Int_Xferred) = InData%MAXINFLO + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%xMinv,1), UBOUND(InData%xMinv,1) + ReKiBuf(Re_Xferred) = InData%xMinv(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackDynInflowParms SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7068,12 +7070,6 @@ SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7088,19 +7084,14 @@ SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MAXINFLO = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MAXINFLO = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xMinv,1) i1_u = UBOUND(OutData%xMinv,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xMinv = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xMinv))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xMinv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xMinv,1), UBOUND(OutData%xMinv,1) + OutData%xMinv(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackDynInflowParms SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) @@ -7203,7 +7194,20 @@ SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, END IF DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS ENDIF +IF (ALLOCATED(SrcElementData%PITNOW)) THEN + i1_l = LBOUND(SrcElementData%PITNOW,1) + i1_u = UBOUND(SrcElementData%PITNOW,1) + i2_l = LBOUND(SrcElementData%PITNOW,2) + i2_u = UBOUND(SrcElementData%PITNOW,2) + IF (.NOT. ALLOCATED(DstElementData%PITNOW)) THEN + ALLOCATE(DstElementData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF DstElementData%PITNOW = SrcElementData%PITNOW +ENDIF END SUBROUTINE AD14_CopyElement SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) @@ -7232,6 +7236,9 @@ SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ElementData%OLD_AP_NS)) THEN DEALLOCATE(ElementData%OLD_AP_NS) +ENDIF +IF (ALLOCATED(ElementData%PITNOW)) THEN + DEALLOCATE(ElementData%PITNOW) ENDIF END SUBROUTINE AD14_DestroyElement @@ -7300,7 +7307,11 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 2*2 ! OLD_AP_NS upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%OLD_AP_NS) ! OLD_AP_NS END IF - Re_BufSz = Re_BufSz + 1 ! PITNOW + Int_BufSz = Int_BufSz + 1 ! PITNOW allocated yes/no + IF ( ALLOCATED(InData%PITNOW) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PITNOW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PITNOW) ! PITNOW + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -7341,8 +7352,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7357,8 +7372,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AP))-1 ) = PACK(InData%AP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AP) + DO i2 = LBOUND(InData%AP,2), UBOUND(InData%AP,2) + DO i1 = LBOUND(InData%AP,1), UBOUND(InData%AP,1) + ReKiBuf(Re_Xferred) = InData%AP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ALPHA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7373,8 +7392,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ALPHA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ALPHA))-1 ) = PACK(InData%ALPHA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ALPHA) + DO i2 = LBOUND(InData%ALPHA,2), UBOUND(InData%ALPHA,2) + DO i1 = LBOUND(InData%ALPHA,1), UBOUND(InData%ALPHA,1) + ReKiBuf(Re_Xferred) = InData%ALPHA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%W2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7389,8 +7412,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W2))-1 ) = PACK(InData%W2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W2) + DO i2 = LBOUND(InData%W2,2), UBOUND(InData%W2,2) + DO i1 = LBOUND(InData%W2,1), UBOUND(InData%W2,1) + ReKiBuf(Re_Xferred) = InData%W2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLD_A_NS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7405,8 +7432,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLD_A_NS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLD_A_NS))-1 ) = PACK(InData%OLD_A_NS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLD_A_NS) + DO i2 = LBOUND(InData%OLD_A_NS,2), UBOUND(InData%OLD_A_NS,2) + DO i1 = LBOUND(InData%OLD_A_NS,1), UBOUND(InData%OLD_A_NS,1) + ReKiBuf(Re_Xferred) = InData%OLD_A_NS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLD_AP_NS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7421,11 +7452,33 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLD_AP_NS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLD_AP_NS))-1 ) = PACK(InData%OLD_AP_NS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLD_AP_NS) + DO i2 = LBOUND(InData%OLD_AP_NS,2), UBOUND(InData%OLD_AP_NS,2) + DO i1 = LBOUND(InData%OLD_AP_NS,1), UBOUND(InData%OLD_AP_NS,1) + ReKiBuf(Re_Xferred) = InData%OLD_AP_NS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PITNOW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PITNOW,2), UBOUND(InData%PITNOW,2) + DO i1 = LBOUND(InData%PITNOW,1), UBOUND(InData%PITNOW,1) + ReKiBuf(Re_Xferred) = InData%PITNOW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PITNOW - Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackElement SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7441,12 +7494,6 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7478,15 +7525,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AP not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7548,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AP)>0) OutData%AP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AP,2), UBOUND(OutData%AP,2) + DO i1 = LBOUND(OutData%AP,1), UBOUND(OutData%AP,1) + OutData%AP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALPHA not allocated Int_Xferred = Int_Xferred + 1 @@ -7530,15 +7571,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ALPHA)>0) OutData%ALPHA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ALPHA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ALPHA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ALPHA,2), UBOUND(OutData%ALPHA,2) + DO i1 = LBOUND(OutData%ALPHA,1), UBOUND(OutData%ALPHA,1) + OutData%ALPHA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7556,15 +7594,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%W2)>0) OutData%W2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%W2,2), UBOUND(OutData%W2,2) + DO i1 = LBOUND(OutData%W2,1), UBOUND(OutData%W2,1) + OutData%W2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_A_NS not allocated Int_Xferred = Int_Xferred + 1 @@ -7582,15 +7617,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLD_A_NS)>0) OutData%OLD_A_NS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLD_A_NS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLD_A_NS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLD_A_NS,2), UBOUND(OutData%OLD_A_NS,2) + DO i1 = LBOUND(OutData%OLD_A_NS,1), UBOUND(OutData%OLD_A_NS,1) + OutData%OLD_A_NS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_AP_NS not allocated Int_Xferred = Int_Xferred + 1 @@ -7608,18 +7640,36 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%OLD_AP_NS,2), UBOUND(OutData%OLD_AP_NS,2) + DO i1 = LBOUND(OutData%OLD_AP_NS,1), UBOUND(OutData%OLD_AP_NS,1) + OutData%OLD_AP_NS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITNOW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PITNOW)) DEALLOCATE(OutData%PITNOW) + ALLOCATE(OutData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLD_AP_NS)>0) OutData%OLD_AP_NS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLD_AP_NS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLD_AP_NS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PITNOW,2), UBOUND(OutData%PITNOW,2) + DO i1 = LBOUND(OutData%PITNOW,1), UBOUND(OutData%PITNOW,1) + OutData%PITNOW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%PITNOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackElement SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -7794,8 +7844,8 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NELM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NELM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TWIST) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7806,8 +7856,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TWIST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TWIST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TWIST))-1 ) = PACK(InData%TWIST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TWIST) + DO i1 = LBOUND(InData%TWIST,1), UBOUND(InData%TWIST,1) + ReKiBuf(Re_Xferred) = InData%TWIST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RELM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7819,8 +7871,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RELM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RELM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RELM))-1 ) = PACK(InData%RELM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RELM) + DO i1 = LBOUND(InData%RELM,1), UBOUND(InData%RELM,1) + ReKiBuf(Re_Xferred) = InData%RELM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HLCNST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7832,8 +7886,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HLCNST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HLCNST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HLCNST))-1 ) = PACK(InData%HLCNST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HLCNST) + DO i1 = LBOUND(InData%HLCNST,1), UBOUND(InData%HLCNST,1) + ReKiBuf(Re_Xferred) = InData%HLCNST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TLCNST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7845,8 +7901,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TLCNST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TLCNST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TLCNST))-1 ) = PACK(InData%TLCNST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TLCNST) + DO i1 = LBOUND(InData%TLCNST,1), UBOUND(InData%TLCNST,1) + ReKiBuf(Re_Xferred) = InData%TLCNST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_PackElementParms @@ -7863,12 +7921,6 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7883,8 +7935,8 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NELM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NELM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TWIST not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7898,15 +7950,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TWIST)>0) OutData%TWIST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TWIST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TWIST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TWIST,1), UBOUND(OutData%TWIST,1) + OutData%TWIST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RELM not allocated Int_Xferred = Int_Xferred + 1 @@ -7921,15 +7968,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RELM)>0) OutData%RELM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RELM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RELM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RELM,1), UBOUND(OutData%RELM,1) + OutData%RELM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HLCNST not allocated Int_Xferred = Int_Xferred + 1 @@ -7944,15 +7986,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HLCNST)>0) OutData%HLCNST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HLCNST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HLCNST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HLCNST,1), UBOUND(OutData%HLCNST,1) + OutData%HLCNST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TLCNST not allocated Int_Xferred = Int_Xferred + 1 @@ -7967,15 +8004,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TLCNST)>0) OutData%TLCNST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TLCNST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TLCNST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TLCNST,1), UBOUND(OutData%TLCNST,1) + OutData%TLCNST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_UnPackElementParms @@ -8163,6 +8195,18 @@ SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, END IF DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum ENDIF +IF (ALLOCATED(SrcElOutParmsData%Gamma)) THEN + i1_l = LBOUND(SrcElOutParmsData%Gamma,1) + i1_u = UBOUND(SrcElOutParmsData%Gamma,1) + IF (.NOT. ALLOCATED(DstElOutParmsData%Gamma)) THEN + ALLOCATE(DstElOutParmsData%Gamma(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%Gamma.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma +ENDIF IF (ALLOCATED(SrcElOutParmsData%SaveVX)) THEN i1_l = LBOUND(SrcElOutParmsData%SaveVX,1) i1_u = UBOUND(SrcElOutParmsData%SaveVX,1) @@ -8311,6 +8355,9 @@ SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg ) IF (ALLOCATED(ElOutParmsData%ReyNum)) THEN DEALLOCATE(ElOutParmsData%ReyNum) ENDIF +IF (ALLOCATED(ElOutParmsData%Gamma)) THEN + DEALLOCATE(ElOutParmsData%Gamma) +ENDIF IF (ALLOCATED(ElOutParmsData%SaveVX)) THEN DEALLOCATE(ElOutParmsData%SaveVX) ENDIF @@ -8439,6 +8486,11 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 2*1 ! ReyNum upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%ReyNum) ! ReyNum END IF + Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no + IF ( ALLOCATED(InData%Gamma) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma + END IF Int_BufSz = Int_BufSz + 1 ! SaveVX allocated yes/no IF ( ALLOCATED(InData%SaveVX) ) THEN Int_BufSz = Int_BufSz + 2*2 ! SaveVX upper/lower bounds for each dimension @@ -8516,8 +8568,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AAA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AAA))-1 ) = PACK(InData%AAA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AAA) + DO i1 = LBOUND(InData%AAA,1), UBOUND(InData%AAA,1) + ReKiBuf(Re_Xferred) = InData%AAA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AAP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8529,8 +8583,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AAP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AAP))-1 ) = PACK(InData%AAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AAP) + DO i1 = LBOUND(InData%AAP,1), UBOUND(InData%AAP,1) + ReKiBuf(Re_Xferred) = InData%AAP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ALF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8542,8 +8598,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ALF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ALF))-1 ) = PACK(InData%ALF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ALF) + DO i1 = LBOUND(InData%ALF,1), UBOUND(InData%ALF,1) + ReKiBuf(Re_Xferred) = InData%ALF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CDD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8555,8 +8613,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CDD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CDD))-1 ) = PACK(InData%CDD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CDD) + DO i1 = LBOUND(InData%CDD,1), UBOUND(InData%CDD,1) + ReKiBuf(Re_Xferred) = InData%CDD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CLL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8568,8 +8628,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CLL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CLL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CLL))-1 ) = PACK(InData%CLL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CLL) + DO i1 = LBOUND(InData%CLL,1), UBOUND(InData%CLL,1) + ReKiBuf(Re_Xferred) = InData%CLL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CMM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8581,8 +8643,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMM))-1 ) = PACK(InData%CMM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMM) + DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) + ReKiBuf(Re_Xferred) = InData%CMM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CNN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8594,8 +8658,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNN,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNN))-1 ) = PACK(InData%CNN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNN) + DO i1 = LBOUND(InData%CNN,1), UBOUND(InData%CNN,1) + ReKiBuf(Re_Xferred) = InData%CNN(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CTT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8607,8 +8673,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CTT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CTT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTT))-1 ) = PACK(InData%CTT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTT) + DO i1 = LBOUND(InData%CTT,1), UBOUND(InData%CTT,1) + ReKiBuf(Re_Xferred) = InData%CTT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DFNSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8620,8 +8688,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFNSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFNSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFNSAV))-1 ) = PACK(InData%DFNSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFNSAV) + DO i1 = LBOUND(InData%DFNSAV,1), UBOUND(InData%DFNSAV,1) + ReKiBuf(Re_Xferred) = InData%DFNSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DFTSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8633,8 +8703,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFTSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFTSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFTSAV))-1 ) = PACK(InData%DFTSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFTSAV) + DO i1 = LBOUND(InData%DFTSAV,1), UBOUND(InData%DFTSAV,1) + ReKiBuf(Re_Xferred) = InData%DFTSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DynPres) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8646,8 +8718,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DynPres,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DynPres)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DynPres))-1 ) = PACK(InData%DynPres,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DynPres) + DO i1 = LBOUND(InData%DynPres,1), UBOUND(InData%DynPres,1) + ReKiBuf(Re_Xferred) = InData%DynPres(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PMM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8659,8 +8733,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMM))-1 ) = PACK(InData%PMM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMM) + DO i1 = LBOUND(InData%PMM,1), UBOUND(InData%PMM,1) + ReKiBuf(Re_Xferred) = InData%PMM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PITSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8672,8 +8748,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PITSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PITSAV))-1 ) = PACK(InData%PITSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PITSAV) + DO i1 = LBOUND(InData%PITSAV,1), UBOUND(InData%PITSAV,1) + ReKiBuf(Re_Xferred) = InData%PITSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ReyNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8685,8 +8763,25 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReyNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ReyNum)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ReyNum))-1 ) = PACK(InData%ReyNum,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ReyNum) + DO i1 = LBOUND(InData%ReyNum,1), UBOUND(InData%ReyNum,1) + ReKiBuf(Re_Xferred) = InData%ReyNum(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Gamma) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) + ReKiBuf(Re_Xferred) = InData%Gamma(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8701,8 +8796,12 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVX))-1 ) = PACK(InData%SaveVX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVX) + DO i2 = LBOUND(InData%SaveVX,2), UBOUND(InData%SaveVX,2) + DO i1 = LBOUND(InData%SaveVX,1), UBOUND(InData%SaveVX,1) + ReKiBuf(Re_Xferred) = InData%SaveVX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8717,8 +8816,12 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVY))-1 ) = PACK(InData%SaveVY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVY) + DO i2 = LBOUND(InData%SaveVY,2), UBOUND(InData%SaveVY,2) + DO i1 = LBOUND(InData%SaveVY,1), UBOUND(InData%SaveVY,1) + ReKiBuf(Re_Xferred) = InData%SaveVY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8733,17 +8836,21 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVZ))-1 ) = PACK(InData%SaveVZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVZ) + DO i2 = LBOUND(InData%SaveVZ,2), UBOUND(InData%SaveVZ,2) + DO i1 = LBOUND(InData%SaveVZ,1), UBOUND(InData%SaveVZ,1) + ReKiBuf(Re_Xferred) = InData%SaveVZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VXSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VYSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VZSAV - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWndElOut - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VXSAV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VYSAV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VZSAV + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWndElOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WndElPrList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8754,8 +8861,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WndElPrList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WndElPrList))-1 ) = PACK(InData%WndElPrList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WndElPrList) + DO i1 = LBOUND(InData%WndElPrList,1), UBOUND(InData%WndElPrList,1) + IntKiBuf(Int_Xferred) = InData%WndElPrList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WndElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8767,8 +8876,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WndElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WndElPrNum))-1 ) = PACK(InData%WndElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WndElPrNum) + DO i1 = LBOUND(InData%WndElPrNum,1), UBOUND(InData%WndElPrNum,1) + IntKiBuf(Int_Xferred) = InData%WndElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElPrList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8780,8 +8891,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrList))-1 ) = PACK(InData%ElPrList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrList) + DO i1 = LBOUND(InData%ElPrList,1), UBOUND(InData%ElPrList,1) + IntKiBuf(Int_Xferred) = InData%ElPrList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8793,11 +8906,13 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrNum))-1 ) = PACK(InData%ElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrNum) + DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) + IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackElOutParms SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -8813,12 +8928,6 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8847,15 +8956,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AAA)>0) OutData%AAA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AAA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AAA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AAA,1), UBOUND(OutData%AAA,1) + OutData%AAA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAP not allocated Int_Xferred = Int_Xferred + 1 @@ -8870,15 +8974,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AAP)>0) OutData%AAP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AAP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AAP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AAP,1), UBOUND(OutData%AAP,1) + OutData%AAP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALF not allocated Int_Xferred = Int_Xferred + 1 @@ -8893,15 +8992,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ALF)>0) OutData%ALF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ALF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ALF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ALF,1), UBOUND(OutData%ALF,1) + OutData%ALF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDD not allocated Int_Xferred = Int_Xferred + 1 @@ -8913,18 +9007,13 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF (ALLOCATED(OutData%CDD)) DEALLOCATE(OutData%CDD) ALLOCATE(OutData%CDD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%CDD)>0) OutData%CDD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CDD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CDD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CDD,1), UBOUND(OutData%CDD,1) + OutData%CDD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CLL not allocated Int_Xferred = Int_Xferred + 1 @@ -8939,15 +9028,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CLL)>0) OutData%CLL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CLL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CLL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CLL,1), UBOUND(OutData%CLL,1) + OutData%CLL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated Int_Xferred = Int_Xferred + 1 @@ -8962,15 +9046,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CMM)>0) OutData%CMM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) + OutData%CMM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNN not allocated Int_Xferred = Int_Xferred + 1 @@ -8985,15 +9064,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CNN)>0) OutData%CNN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CNN,1), UBOUND(OutData%CNN,1) + OutData%CNN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CTT not allocated Int_Xferred = Int_Xferred + 1 @@ -9008,15 +9082,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CTT)>0) OutData%CTT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CTT,1), UBOUND(OutData%CTT,1) + OutData%CTT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFNSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9031,15 +9100,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DFNSAV)>0) OutData%DFNSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFNSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFNSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DFNSAV,1), UBOUND(OutData%DFNSAV,1) + OutData%DFNSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFTSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9054,15 +9118,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DFTSAV)>0) OutData%DFTSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFTSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFTSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DFTSAV,1), UBOUND(OutData%DFTSAV,1) + OutData%DFTSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DynPres not allocated Int_Xferred = Int_Xferred + 1 @@ -9077,15 +9136,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DynPres)>0) OutData%DynPres = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DynPres))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DynPres) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DynPres,1), UBOUND(OutData%DynPres,1) + OutData%DynPres(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMM not allocated Int_Xferred = Int_Xferred + 1 @@ -9100,15 +9154,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PMM)>0) OutData%PMM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PMM,1), UBOUND(OutData%PMM,1) + OutData%PMM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9123,15 +9172,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PITSAV)>0) OutData%PITSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PITSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PITSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PITSAV,1), UBOUND(OutData%PITSAV,1) + OutData%PITSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReyNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9146,15 +9190,28 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%ReyNum,1), UBOUND(OutData%ReyNum,1) + OutData%ReyNum(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Gamma)) DEALLOCATE(OutData%Gamma) + ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%ReyNum)>0) OutData%ReyNum = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ReyNum))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ReyNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) + OutData%Gamma(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVX not allocated Int_Xferred = Int_Xferred + 1 @@ -9172,15 +9229,12 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVX)>0) OutData%SaveVX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVX))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SaveVX,2), UBOUND(OutData%SaveVX,2) + DO i1 = LBOUND(OutData%SaveVX,1), UBOUND(OutData%SaveVX,1) + OutData%SaveVX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVY not allocated Int_Xferred = Int_Xferred + 1 @@ -9198,15 +9252,12 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVY)>0) OutData%SaveVY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVY))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SaveVY,2), UBOUND(OutData%SaveVY,2) + DO i1 = LBOUND(OutData%SaveVY,1), UBOUND(OutData%SaveVY,1) + OutData%SaveVY(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVZ not allocated Int_Xferred = Int_Xferred + 1 @@ -9224,24 +9275,21 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVZ)>0) OutData%SaveVZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVZ) - DEALLOCATE(mask2) - END IF - OutData%VXSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VYSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VZSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumWndElOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%SaveVZ,2), UBOUND(OutData%SaveVZ,2) + DO i1 = LBOUND(OutData%SaveVZ,1), UBOUND(OutData%SaveVZ,1) + OutData%SaveVZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%VXSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VYSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VZSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumWndElOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9255,15 +9303,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WndElPrList)>0) OutData%WndElPrList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WndElPrList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WndElPrList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WndElPrList,1), UBOUND(OutData%WndElPrList,1) + OutData%WndElPrList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9278,15 +9321,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WndElPrNum)>0) OutData%WndElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WndElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WndElPrNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WndElPrNum,1), UBOUND(OutData%WndElPrNum,1) + OutData%WndElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrList not allocated Int_Xferred = Int_Xferred + 1 @@ -9301,15 +9339,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrList)>0) OutData%ElPrList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElPrList,1), UBOUND(OutData%ElPrList,1) + OutData%ElPrList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9324,18 +9357,13 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrNum)>0) OutData%ElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) + OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NumElOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumElOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackElOutParms SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) @@ -9429,8 +9457,8 @@ SUBROUTINE AD14_PackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SumInFl - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SumInFl + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackInducedVel SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9446,12 +9474,6 @@ SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVel' @@ -9465,8 +9487,8 @@ SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SumInFl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%SumInFl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackInducedVel SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -9572,20 +9594,20 @@ SUBROUTINE AD14_PackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EqAIDmult - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilDA , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GTech , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AToler + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EqAIDmult + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDA, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GTech, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackInducedVelParms SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9601,12 +9623,6 @@ SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVelParms' @@ -9620,20 +9636,20 @@ SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AToler = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EqAIDmult = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EquilDA = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%EquilDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GTech = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%HLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%AToler = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EqAIDmult = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EquilDA = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDA) + Int_Xferred = Int_Xferred + 1 + OutData%EquilDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDT) + Int_Xferred = Int_Xferred + 1 + OutData%TLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TLoss) + Int_Xferred = Int_Xferred + 1 + OutData%GTech = TRANSFER(IntKiBuf(Int_Xferred), OutData%GTech) + Int_Xferred = Int_Xferred + 1 + OutData%HLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HLoss) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackInducedVelParms SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) @@ -9743,24 +9759,24 @@ SUBROUTINE AD14_PackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AVGINFL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CTILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%REVS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%STILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAng - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawVEL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AVGINFL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CTILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%REVS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%STILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAng + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawVEL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackRotor SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9776,12 +9792,6 @@ SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotor' @@ -9795,24 +9805,24 @@ SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AVGINFL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CTILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%REVS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%STILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAng = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawVEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AVGINFL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CTILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%REVS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%STILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAng = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawVEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackRotor SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -9906,8 +9916,8 @@ SUBROUTINE AD14_PackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HH - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HH + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackRotorParms SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9923,12 +9933,6 @@ SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotorParms' @@ -9942,8 +9946,8 @@ SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%HH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackRotorParms SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -10201,8 +10205,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHtFr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrHtFr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrHtFr))-1 ) = PACK(InData%TwrHtFr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrHtFr) + DO i1 = LBOUND(InData%TwrHtFr,1), UBOUND(InData%TwrHtFr,1) + ReKiBuf(Re_Xferred) = InData%TwrHtFr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrWid) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10214,8 +10220,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrWid,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrWid)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrWid))-1 ) = PACK(InData%TwrWid,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrWid) + DO i1 = LBOUND(InData%TwrWid,1), UBOUND(InData%TwrWid,1) + ReKiBuf(Re_Xferred) = InData%TwrWid(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10230,8 +10238,12 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCD))-1 ) = PACK(InData%TwrCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCD) + DO i2 = LBOUND(InData%TwrCD,2), UBOUND(InData%TwrCD,2) + DO i1 = LBOUND(InData%TwrCD,1), UBOUND(InData%TwrCD,1) + ReKiBuf(Re_Xferred) = InData%TwrCD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrRe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10243,13 +10255,17 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRe,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrRe)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrRe))-1 ) = PACK(InData%TwrRe,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrRe) + DO i1 = LBOUND(InData%TwrRe,1), UBOUND(InData%TwrRe,1) + ReKiBuf(Re_Xferred) = InData%TwrRe(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VTwr))-1 ) = PACK(InData%VTwr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VTwr) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tower_Wake_Constant - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%VTwr,1), UBOUND(InData%VTwr,1) + ReKiBuf(Re_Xferred) = InData%VTwr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Tower_Wake_Constant + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NTwrCDCol) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10260,39 +10276,41 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTwrCDCol,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NTwrCDCol)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTwrCDCol))-1 ) = PACK(InData%NTwrCDCol,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTwrCDCol) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrHT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrRe - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrCD - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrPotent , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShadHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TShadC1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TShadC2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrShad - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PJM_Version , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TwrFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_Shad_Refpt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CalcTwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%NTwrCDCol,1), UBOUND(InData%NTwrCDCol,1) + IntKiBuf(Int_Xferred) = InData%NTwrCDCol(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NTwrHT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwrRe + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwrCD + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrPotent, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShadHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TShadC1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TShadC2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrShad + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PJM_Version, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TwrFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%T_Shad_Refpt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcTwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrNodeWidth) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10303,8 +10321,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeWidth,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrNodeWidth)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrNodeWidth))-1 ) = PACK(InData%TwrNodeWidth,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrNodeWidth) + DO i1 = LBOUND(InData%TwrNodeWidth,1), UBOUND(InData%TwrNodeWidth,1) + ReKiBuf(Re_Xferred) = InData%TwrNodeWidth(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_PackTwrPropsParms @@ -10321,12 +10341,6 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -10355,15 +10369,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrHtFr)>0) OutData%TwrHtFr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrHtFr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrHtFr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrHtFr,1), UBOUND(OutData%TwrHtFr,1) + OutData%TwrHtFr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrWid not allocated Int_Xferred = Int_Xferred + 1 @@ -10378,15 +10387,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrWid)>0) OutData%TwrWid = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrWid))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrWid) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrWid,1), UBOUND(OutData%TwrWid,1) + OutData%TwrWid(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCD not allocated Int_Xferred = Int_Xferred + 1 @@ -10404,15 +10408,12 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrCD)>0) OutData%TwrCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrCD,2), UBOUND(OutData%TwrCD,2) + DO i1 = LBOUND(OutData%TwrCD,1), UBOUND(OutData%TwrCD,1) + OutData%TwrCD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRe not allocated Int_Xferred = Int_Xferred + 1 @@ -10427,29 +10428,19 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrRe)>0) OutData%TwrRe = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrRe))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrRe) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrRe,1), UBOUND(OutData%TwrRe,1) + OutData%TwrRe(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%VTwr,1) i1_u = UBOUND(OutData%VTwr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%VTwr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VTwr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VTwr) - DEALLOCATE(mask1) - OutData%Tower_Wake_Constant = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%VTwr,1), UBOUND(OutData%VTwr,1) + OutData%VTwr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Tower_Wake_Constant = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTwrCDCol not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10463,46 +10454,41 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NTwrCDCol)>0) OutData%NTwrCDCol = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTwrCDCol))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTwrCDCol) - DEALLOCATE(mask1) - END IF - OutData%NTwrHT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrRe = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrCD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%ShadHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrShad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PJM_Version = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TwrFile) - OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%T_Shad_Refpt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CalcTwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NTwrCDCol,1), UBOUND(OutData%NTwrCDCol,1) + OutData%NTwrCDCol(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NTwrHT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwrRe = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwrCD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrPotent) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%ShadHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TShadC1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TShadC2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrShad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PJM_Version = TRANSFER(IntKiBuf(Int_Xferred), OutData%PJM_Version) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TwrFile) + OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%T_Shad_Refpt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CalcTwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcTwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeWidth not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10516,15 +10502,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrNodeWidth)>0) OutData%TwrNodeWidth = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrNodeWidth))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrNodeWidth) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrNodeWidth,1), UBOUND(OutData%TwrNodeWidth,1) + OutData%TwrNodeWidth(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_UnPackTwrPropsParms @@ -10629,18 +10610,18 @@ SUBROUTINE AD14_PackWind( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ANGFLW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CDEL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SDEL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ANGFLW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CDEL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SDEL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackWind SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10656,12 +10637,6 @@ SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWind' @@ -10675,18 +10650,18 @@ SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%ANGFLW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CDEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SDEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%ANGFLW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CDEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SDEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackWind SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -10782,10 +10757,10 @@ SUBROUTINE AD14_PackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rho + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackWindParms SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10801,12 +10776,6 @@ SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWindParms' @@ -10820,10 +10789,10 @@ SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Rho = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Rho = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackWindParms SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -10918,8 +10887,10 @@ SUBROUTINE AD14_PackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Pos))-1 ) = PACK(InData%Pos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Pos) + DO i1 = LBOUND(InData%Pos,1), UBOUND(InData%Pos,1) + ReKiBuf(Re_Xferred) = InData%Pos(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackPositionType SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10935,12 +10906,6 @@ SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10957,15 +10922,10 @@ SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%Pos,1) i1_u = UBOUND(OutData%Pos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Pos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Pos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Pos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Pos,1), UBOUND(OutData%Pos,1) + OutData%Pos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackPositionType SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -11061,8 +11021,12 @@ SUBROUTINE AD14_PackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orient))-1 ) = PACK(InData%Orient,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orient) + DO i2 = LBOUND(InData%Orient,2), UBOUND(InData%Orient,2) + DO i1 = LBOUND(InData%Orient,1), UBOUND(InData%Orient,1) + ReKiBuf(Re_Xferred) = InData%Orient(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_PackOrientationType SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11078,12 +11042,6 @@ SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -11103,15 +11061,12 @@ SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS i1_u = UBOUND(OutData%Orient,1) i2_l = LBOUND(OutData%Orient,2) i2_u = UBOUND(OutData%Orient,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orient = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orient))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orient) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Orient,2), UBOUND(OutData%Orient,2) + DO i1 = LBOUND(OutData%Orient,1), UBOUND(OutData%Orient,1) + OutData%Orient(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_UnPackOrientationType SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -11290,28 +11245,28 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ADFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrSumFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinearizeFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Title) + IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%ADFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSumFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11340,8 +11295,8 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrNodeLocs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11355,11 +11310,15 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrNodeLocs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrNodeLocs))-1 ) = PACK(InData%TwrNodeLocs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrNodeLocs) + DO i2 = LBOUND(InData%TwrNodeLocs,2), UBOUND(InData%TwrNodeLocs,2) + DO i1 = LBOUND(InData%TwrNodeLocs,1), UBOUND(InData%TwrNodeLocs,1) + ReKiBuf(Re_Xferred) = InData%TwrNodeLocs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11403,12 +11362,6 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -11424,28 +11377,28 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ADFileName) - OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrSumFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LinearizeFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Title) + OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%ADFileName) + OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WrSumFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSumFile) + Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11486,8 +11439,8 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumTwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeLocs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -11504,18 +11457,15 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrNodeLocs)>0) OutData%TwrNodeLocs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrNodeLocs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrNodeLocs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrNodeLocs,2), UBOUND(OutData%TwrNodeLocs,2) + DO i1 = LBOUND(OutData%TwrNodeLocs,1), UBOUND(OutData%TwrNodeLocs,1) + OutData%TwrNodeLocs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11748,8 +11698,8 @@ SUBROUTINE AD14_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackInitOutput SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11765,12 +11715,6 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInitOutput' @@ -11864,8 +11808,8 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackInitOutput SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -12022,12 +11966,6 @@ SUBROUTINE AD14_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackContState' @@ -12237,12 +12175,6 @@ SUBROUTINE AD14_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackDiscState' @@ -12452,12 +12384,6 @@ SUBROUTINE AD14_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackConstrState' @@ -12667,12 +12593,6 @@ SUBROUTINE AD14_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackOtherState' @@ -13236,8 +13156,8 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13248,33 +13168,35 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrNum))-1 ) = PACK(InData%ElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrNum) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%OldTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Loss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TLpt7 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstPassGTL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SuperSonic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AFLAGVinderr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AFLAGTwrInflu , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OnePassDynDbg , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NoLoadsCalculated , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NERRORS - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) + IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%OldTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubLoss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Loss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipLoss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TLpt7 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPassGTL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SuperSonic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGVinderr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGTwrInflu, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OnePassDynDbg, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NoLoadsCalculated, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NERRORS + Int_Xferred = Int_Xferred + 1 CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13499,12 +13421,12 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Skew , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Skew, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%StoredForces) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13521,8 +13443,14 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StoredForces)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StoredForces))-1 ) = PACK(InData%StoredForces,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StoredForces) + DO i3 = LBOUND(InData%StoredForces,3), UBOUND(InData%StoredForces,3) + DO i2 = LBOUND(InData%StoredForces,2), UBOUND(InData%StoredForces,2) + DO i1 = LBOUND(InData%StoredForces,1), UBOUND(InData%StoredForces,1) + ReKiBuf(Re_Xferred) = InData%StoredForces(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StoredMoments) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -13540,8 +13468,14 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StoredMoments)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StoredMoments))-1 ) = PACK(InData%StoredMoments,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StoredMoments) + DO i3 = LBOUND(InData%StoredMoments,3), UBOUND(InData%StoredMoments,3) + DO i2 = LBOUND(InData%StoredMoments,2), UBOUND(InData%StoredMoments,2) + DO i1 = LBOUND(InData%StoredMoments,1), UBOUND(InData%StoredMoments,1) + ReKiBuf(Re_Xferred) = InData%StoredMoments(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD14_PackMisc @@ -13558,12 +13492,6 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -13700,8 +13628,8 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13715,40 +13643,35 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrNum)>0) OutData%ElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrNum) - DEALLOCATE(mask1) - END IF - OutData%OldTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HubLoss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Loss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TLpt7 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FirstPassGTL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SuperSonic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGVinderr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGTwrInflu = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OnePassDynDbg = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NoLoadsCalculated = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NERRORS = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) + OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%OldTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HubLoss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Loss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipLoss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TLpt7 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FirstPassGTL = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPassGTL) + Int_Xferred = Int_Xferred + 1 + OutData%SuperSonic = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuperSonic) + Int_Xferred = Int_Xferred + 1 + OutData%AFLAGVinderr = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGVinderr) + Int_Xferred = Int_Xferred + 1 + OutData%AFLAGTwrInflu = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGTwrInflu) + Int_Xferred = Int_Xferred + 1 + OutData%OnePassDynDbg = TRANSFER(IntKiBuf(Int_Xferred), OutData%OnePassDynDbg) + Int_Xferred = Int_Xferred + 1 + OutData%NoLoadsCalculated = TRANSFER(IntKiBuf(Int_Xferred), OutData%NoLoadsCalculated) + Int_Xferred = Int_Xferred + 1 + OutData%NERRORS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14069,12 +13992,12 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Skew = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%Skew) + Int_Xferred = Int_Xferred + 1 + OutData%DynInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInit) + Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredForces not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14094,15 +14017,14 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%StoredForces)>0) OutData%StoredForces = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StoredForces))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StoredForces) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%StoredForces,3), UBOUND(OutData%StoredForces,3) + DO i2 = LBOUND(OutData%StoredForces,2), UBOUND(OutData%StoredForces,2) + DO i1 = LBOUND(OutData%StoredForces,1), UBOUND(OutData%StoredForces,1) + OutData%StoredForces(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredMoments not allocated Int_Xferred = Int_Xferred + 1 @@ -14123,15 +14045,14 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%StoredMoments)>0) OutData%StoredMoments = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StoredMoments))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StoredMoments) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%StoredMoments,3), UBOUND(OutData%StoredMoments,3) + DO i2 = LBOUND(OutData%StoredMoments,2), UBOUND(OutData%StoredMoments,2) + DO i1 = LBOUND(OutData%StoredMoments,1), UBOUND(OutData%StoredMoments,1) + OutData%StoredMoments(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD14_UnPackMisc @@ -14485,58 +14406,58 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SIUnit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MultiTab , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinearizeFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutputPlottingInfo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwoPiNB - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ElemPrn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DStall , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PMoment , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Reynolds , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynInfl , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Wake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Swirl , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DtAero - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnEc - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnWndOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MAXICOUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrOptFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DEFAULT_Wind - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Title) + IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%SIUnit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MultiTab, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputPlottingInfo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwoPiNB + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlInpSt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ElemPrn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DStall, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PMoment, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Reynolds, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInfl, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Wake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DtAero + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnEc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnWndOut + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MAXICOUNT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrOptFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DEFAULT_Wind + Int_Xferred = Int_Xferred + 1 CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14832,12 +14753,6 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackParam' @@ -14851,58 +14766,58 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SIUnit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MultiTab = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LinearizeFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutputPlottingInfo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NBlInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ElemPrn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DStall = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PMoment = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Reynolds = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynInfl = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Wake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DtAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UnEc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnElem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnWndOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MAXICOUNT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WrOptFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DEFAULT_Wind = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Title) + OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SIUnit = TRANSFER(IntKiBuf(Int_Xferred), OutData%SIUnit) + Int_Xferred = Int_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%MultiTab = TRANSFER(IntKiBuf(Int_Xferred), OutData%MultiTab) + Int_Xferred = Int_Xferred + 1 + OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) + Int_Xferred = Int_Xferred + 1 + OutData%OutputPlottingInfo = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputPlottingInfo) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 + OutData%TwoPiNB = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NBlInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElemPrn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ElemPrn) + Int_Xferred = Int_Xferred + 1 + OutData%DStall = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStall) + Int_Xferred = Int_Xferred + 1 + OutData%PMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%PMoment) + Int_Xferred = Int_Xferred + 1 + OutData%Reynolds = TRANSFER(IntKiBuf(Int_Xferred), OutData%Reynolds) + Int_Xferred = Int_Xferred + 1 + OutData%DynInfl = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInfl) + Int_Xferred = Int_Xferred + 1 + OutData%Wake = TRANSFER(IntKiBuf(Int_Xferred), OutData%Wake) + Int_Xferred = Int_Xferred + 1 + OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) + Int_Xferred = Int_Xferred + 1 + OutData%DtAero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UnEc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnWndOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MAXICOUNT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrOptFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrOptFile) + Int_Xferred = Int_Xferred + 1 + OutData%DEFAULT_Wind = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -15640,8 +15555,12 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MulTabLoc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabLoc))-1 ) = PACK(InData%MulTabLoc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabLoc) + DO i2 = LBOUND(InData%MulTabLoc,2), UBOUND(InData%MulTabLoc,2) + DO i1 = LBOUND(InData%MulTabLoc,1), UBOUND(InData%MulTabLoc,1) + ReKiBuf(Re_Xferred) = InData%MulTabLoc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InflowVelocity) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -15656,11 +15575,17 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowVelocity)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowVelocity))-1 ) = PACK(InData%InflowVelocity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowVelocity) + DO i2 = LBOUND(InData%InflowVelocity,2), UBOUND(InData%InflowVelocity,2) + DO i1 = LBOUND(InData%InflowVelocity,1), UBOUND(InData%InflowVelocity,1) + ReKiBuf(Re_Xferred) = InData%InflowVelocity(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AvgInfVel))-1 ) = PACK(InData%AvgInfVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AvgInfVel) + DO i1 = LBOUND(InData%AvgInfVel,1), UBOUND(InData%AvgInfVel,1) + ReKiBuf(Re_Xferred) = InData%AvgInfVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackInput SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15676,12 +15601,6 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -15849,15 +15768,12 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabLoc)>0) OutData%MulTabLoc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabLoc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabLoc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MulTabLoc,2), UBOUND(OutData%MulTabLoc,2) + DO i1 = LBOUND(OutData%MulTabLoc,1), UBOUND(OutData%MulTabLoc,1) + OutData%MulTabLoc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowVelocity not allocated Int_Xferred = Int_Xferred + 1 @@ -15875,27 +15791,19 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InflowVelocity)>0) OutData%InflowVelocity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowVelocity))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowVelocity) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowVelocity,2), UBOUND(OutData%InflowVelocity,2) + DO i1 = LBOUND(OutData%InflowVelocity,1), UBOUND(OutData%InflowVelocity,1) + OutData%InflowVelocity(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%AvgInfVel,1) i1_u = UBOUND(OutData%AvgInfVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AvgInfVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AvgInfVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AvgInfVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AvgInfVel,1), UBOUND(OutData%AvgInfVel,1) + OutData%AvgInfVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackInput SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -16139,12 +16047,6 @@ SUBROUTINE AD14_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -16332,16 +16234,16 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -16354,9 +16256,11 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i01 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp1(u1%InputMarkers(i01), u2%InputMarkers(i01), tin, u_out%InputMarkers(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -16364,230 +16268,180 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%Position - u2%TurbineComponents%Blade(i11)%Position)/t(2) - u_out%TurbineComponents%Blade(i11)%Position = u1%TurbineComponents%Blade(i11)%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) + b = -(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b * ScaleFactor + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - b2 = -(u1%TurbineComponents%Blade(i11)%Orientation - u2%TurbineComponents%Blade(i11)%Orientation)/t(2) - u_out%TurbineComponents%Blade(i11)%Orientation = u1%TurbineComponents%Blade(i11)%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) + b = -(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%TranslationVel - u2%TurbineComponents%Blade(i11)%TranslationVel)/t(2) - u_out%TurbineComponents%Blade(i11)%TranslationVel = u1%TurbineComponents%Blade(i11)%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) + b = -(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b * ScaleFactor + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%RotationVel - u2%TurbineComponents%Blade(i11)%RotationVel)/t(2) - u_out%TurbineComponents%Blade(i11)%RotationVel = u1%TurbineComponents%Blade(i11)%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) + b = -(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b * ScaleFactor + END DO ENDDO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - b1 = -(u1%TurbineComponents%Hub%Position - u2%TurbineComponents%Hub%Position)/t(2) - u_out%TurbineComponents%Hub%Position = u1%TurbineComponents%Hub%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - b2 = -(u1%TurbineComponents%Hub%Orientation - u2%TurbineComponents%Hub%Orientation)/t(2) - u_out%TurbineComponents%Hub%Orientation = u1%TurbineComponents%Hub%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Hub%TranslationVel - u2%TurbineComponents%Hub%TranslationVel)/t(2) - u_out%TurbineComponents%Hub%TranslationVel = u1%TurbineComponents%Hub%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - b1 = -(u1%TurbineComponents%Hub%RotationVel - u2%TurbineComponents%Hub%RotationVel)/t(2) - u_out%TurbineComponents%Hub%RotationVel = u1%TurbineComponents%Hub%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - b1 = -(u1%TurbineComponents%RotorFurl%Position - u2%TurbineComponents%RotorFurl%Position)/t(2) - u_out%TurbineComponents%RotorFurl%Position = u1%TurbineComponents%RotorFurl%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - b2 = -(u1%TurbineComponents%RotorFurl%Orientation - u2%TurbineComponents%RotorFurl%Orientation)/t(2) - u_out%TurbineComponents%RotorFurl%Orientation = u1%TurbineComponents%RotorFurl%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - b1 = -(u1%TurbineComponents%RotorFurl%TranslationVel - u2%TurbineComponents%RotorFurl%TranslationVel)/t(2) - u_out%TurbineComponents%RotorFurl%TranslationVel = u1%TurbineComponents%RotorFurl%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - b1 = -(u1%TurbineComponents%RotorFurl%RotationVel - u2%TurbineComponents%RotorFurl%RotationVel)/t(2) - u_out%TurbineComponents%RotorFurl%RotationVel = u1%TurbineComponents%RotorFurl%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - b1 = -(u1%TurbineComponents%Nacelle%Position - u2%TurbineComponents%Nacelle%Position)/t(2) - u_out%TurbineComponents%Nacelle%Position = u1%TurbineComponents%Nacelle%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - b2 = -(u1%TurbineComponents%Nacelle%Orientation - u2%TurbineComponents%Nacelle%Orientation)/t(2) - u_out%TurbineComponents%Nacelle%Orientation = u1%TurbineComponents%Nacelle%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Nacelle%TranslationVel - u2%TurbineComponents%Nacelle%TranslationVel)/t(2) - u_out%TurbineComponents%Nacelle%TranslationVel = u1%TurbineComponents%Nacelle%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - b1 = -(u1%TurbineComponents%Nacelle%RotationVel - u2%TurbineComponents%Nacelle%RotationVel)/t(2) - u_out%TurbineComponents%Nacelle%RotationVel = u1%TurbineComponents%Nacelle%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - b1 = -(u1%TurbineComponents%TailFin%Position - u2%TurbineComponents%TailFin%Position)/t(2) - u_out%TurbineComponents%TailFin%Position = u1%TurbineComponents%TailFin%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - b2 = -(u1%TurbineComponents%TailFin%Orientation - u2%TurbineComponents%TailFin%Orientation)/t(2) - u_out%TurbineComponents%TailFin%Orientation = u1%TurbineComponents%TailFin%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - b1 = -(u1%TurbineComponents%TailFin%TranslationVel - u2%TurbineComponents%TailFin%TranslationVel)/t(2) - u_out%TurbineComponents%TailFin%TranslationVel = u1%TurbineComponents%TailFin%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - b1 = -(u1%TurbineComponents%TailFin%RotationVel - u2%TurbineComponents%TailFin%RotationVel)/t(2) - u_out%TurbineComponents%TailFin%RotationVel = u1%TurbineComponents%TailFin%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - b1 = -(u1%TurbineComponents%Tower%Position - u2%TurbineComponents%Tower%Position)/t(2) - u_out%TurbineComponents%Tower%Position = u1%TurbineComponents%Tower%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - b2 = -(u1%TurbineComponents%Tower%Orientation - u2%TurbineComponents%Tower%Orientation)/t(2) - u_out%TurbineComponents%Tower%Orientation = u1%TurbineComponents%Tower%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Tower%TranslationVel - u2%TurbineComponents%Tower%TranslationVel)/t(2) - u_out%TurbineComponents%Tower%TranslationVel = u1%TurbineComponents%Tower%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - b1 = -(u1%TurbineComponents%Tower%RotationVel - u2%TurbineComponents%Tower%RotationVel)/t(2) - u_out%TurbineComponents%Tower%RotationVel = u1%TurbineComponents%Tower%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - b1 = -(u1%TurbineComponents%SubStructure%Position - u2%TurbineComponents%SubStructure%Position)/t(2) - u_out%TurbineComponents%SubStructure%Position = u1%TurbineComponents%SubStructure%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - b2 = -(u1%TurbineComponents%SubStructure%Orientation - u2%TurbineComponents%SubStructure%Orientation)/t(2) - u_out%TurbineComponents%SubStructure%Orientation = u1%TurbineComponents%SubStructure%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - b1 = -(u1%TurbineComponents%SubStructure%TranslationVel - u2%TurbineComponents%SubStructure%TranslationVel)/t(2) - u_out%TurbineComponents%SubStructure%TranslationVel = u1%TurbineComponents%SubStructure%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - b1 = -(u1%TurbineComponents%SubStructure%RotationVel - u2%TurbineComponents%SubStructure%RotationVel)/t(2) - u_out%TurbineComponents%SubStructure%RotationVel = u1%TurbineComponents%SubStructure%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - b1 = -(u1%TurbineComponents%Foundation%Position - u2%TurbineComponents%Foundation%Position)/t(2) - u_out%TurbineComponents%Foundation%Position = u1%TurbineComponents%Foundation%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - b2 = -(u1%TurbineComponents%Foundation%Orientation - u2%TurbineComponents%Foundation%Orientation)/t(2) - u_out%TurbineComponents%Foundation%Orientation = u1%TurbineComponents%Foundation%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Foundation%TranslationVel - u2%TurbineComponents%Foundation%TranslationVel)/t(2) - u_out%TurbineComponents%Foundation%TranslationVel = u1%TurbineComponents%Foundation%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - b1 = -(u1%TurbineComponents%Foundation%RotationVel - u2%TurbineComponents%Foundation%RotationVel)/t(2) - u_out%TurbineComponents%Foundation%RotationVel = u1%TurbineComponents%Foundation%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength)/t(2) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b0 * t_out + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) + b = -(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) + b = -(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) + b = -(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) + b = -(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) + b = -(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) + b = -(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) + b = -(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) + b = -(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) + b = -(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) + b = -(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) + b = -(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) + b = -(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) + b = -(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) + b = -(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) + b = -(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) + b = -(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) + b = -(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) + b = -(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) + b = -(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) + b = -(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) + b = -(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) + b = -(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) + b = -(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) + b = -(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) + b = -(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) + b = -(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) + b = -(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) + b = -(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b * ScaleFactor + END DO + b = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b * ScaleFactor IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - ALLOCATE(b2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - ALLOCATE(c2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - b2 = -(u1%MulTabLoc - u2%MulTabLoc)/t(2) - u_out%MulTabLoc = u1%MulTabLoc + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) + DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) + b = -(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - ALLOCATE(b2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - ALLOCATE(c2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - b2 = -(u1%InflowVelocity - u2%InflowVelocity)/t(2) - u_out%InflowVelocity = u1%InflowVelocity + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) + DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) + b = -(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%AvgInfVel,1))) - ALLOCATE(c1(SIZE(u_out%AvgInfVel,1))) - b1 = -(u1%AvgInfVel - u2%AvgInfVel)/t(2) - u_out%AvgInfVel = u1%AvgInfVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) + b = -(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b * ScaleFactor + END DO END SUBROUTINE AD14_Input_ExtrapInterp1 @@ -16617,17 +16471,18 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -16646,9 +16501,11 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i01 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp2(u1%InputMarkers(i01), u2%InputMarkers(i01), u3%InputMarkers(i01), tin, u_out%InputMarkers(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -16656,266 +16513,216 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position - u2%TurbineComponents%Blade(i11)%Position) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position + u3%TurbineComponents%Blade(i11)%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position + t(3)*u2%TurbineComponents%Blade(i11)%Position - t(2)*u3%TurbineComponents%Blade(i11)%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%Position = u1%TurbineComponents%Blade(i11)%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position(i1) + u3%TurbineComponents%Blade(i11)%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position(i1) + t(3)*u2%TurbineComponents%Blade(i11)%Position(i1) - t(2)*u3%TurbineComponents%Blade(i11)%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b + c * t_out + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation - u2%TurbineComponents%Blade(i11)%Orientation) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation + u3%TurbineComponents%Blade(i11)%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation + t(3)*u2%TurbineComponents%Blade(i11)%Orientation - t(2)*u3%TurbineComponents%Blade(i11)%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%Orientation = u1%TurbineComponents%Blade(i11)%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + u3%TurbineComponents%Blade(i11)%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Blade(i11)%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Blade(i11)%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b + c * t_out + END DO + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel - u2%TurbineComponents%Blade(i11)%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel + u3%TurbineComponents%Blade(i11)%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%TranslationVel = u1%TurbineComponents%Blade(i11)%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + u3%TurbineComponents%Blade(i11)%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b + c * t_out + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel - u2%TurbineComponents%Blade(i11)%RotationVel) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel + u3%TurbineComponents%Blade(i11)%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%RotationVel = u1%TurbineComponents%Blade(i11)%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel(i1) + u3%TurbineComponents%Blade(i11)%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b + c * t_out + END DO ENDDO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%Position - u2%TurbineComponents%Hub%Position) + t(2)**2*(-u1%TurbineComponents%Hub%Position + u3%TurbineComponents%Hub%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position + t(3)*u2%TurbineComponents%Hub%Position - t(2)*u3%TurbineComponents%Hub%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%Position = u1%TurbineComponents%Hub%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Hub%Orientation - u2%TurbineComponents%Hub%Orientation) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation + u3%TurbineComponents%Hub%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation + t(3)*u2%TurbineComponents%Hub%Orientation - t(2)*u3%TurbineComponents%Hub%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%Orientation = u1%TurbineComponents%Hub%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel - u2%TurbineComponents%Hub%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel + u3%TurbineComponents%Hub%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel + t(3)*u2%TurbineComponents%Hub%TranslationVel - t(2)*u3%TurbineComponents%Hub%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%TranslationVel = u1%TurbineComponents%Hub%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel - u2%TurbineComponents%Hub%RotationVel) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel + u3%TurbineComponents%Hub%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel + t(3)*u2%TurbineComponents%Hub%RotationVel - t(2)*u3%TurbineComponents%Hub%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%RotationVel = u1%TurbineComponents%Hub%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position - u2%TurbineComponents%RotorFurl%Position) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position + u3%TurbineComponents%RotorFurl%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position + t(3)*u2%TurbineComponents%RotorFurl%Position - t(2)*u3%TurbineComponents%RotorFurl%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%Position = u1%TurbineComponents%RotorFurl%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation - u2%TurbineComponents%RotorFurl%Orientation) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation + u3%TurbineComponents%RotorFurl%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation + t(3)*u2%TurbineComponents%RotorFurl%Orientation - t(2)*u3%TurbineComponents%RotorFurl%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%Orientation = u1%TurbineComponents%RotorFurl%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel - u2%TurbineComponents%RotorFurl%TranslationVel) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel + u3%TurbineComponents%RotorFurl%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%TranslationVel = u1%TurbineComponents%RotorFurl%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel - u2%TurbineComponents%RotorFurl%RotationVel) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel + u3%TurbineComponents%RotorFurl%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel + t(3)*u2%TurbineComponents%RotorFurl%RotationVel - t(2)*u3%TurbineComponents%RotorFurl%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%RotationVel = u1%TurbineComponents%RotorFurl%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%Position - u2%TurbineComponents%Nacelle%Position) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position + u3%TurbineComponents%Nacelle%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position + t(3)*u2%TurbineComponents%Nacelle%Position - t(2)*u3%TurbineComponents%Nacelle%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%Position = u1%TurbineComponents%Nacelle%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation - u2%TurbineComponents%Nacelle%Orientation) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation + u3%TurbineComponents%Nacelle%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation + t(3)*u2%TurbineComponents%Nacelle%Orientation - t(2)*u3%TurbineComponents%Nacelle%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%Orientation = u1%TurbineComponents%Nacelle%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel - u2%TurbineComponents%Nacelle%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel + u3%TurbineComponents%Nacelle%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel + t(3)*u2%TurbineComponents%Nacelle%TranslationVel - t(2)*u3%TurbineComponents%Nacelle%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%TranslationVel = u1%TurbineComponents%Nacelle%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel - u2%TurbineComponents%Nacelle%RotationVel) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel + u3%TurbineComponents%Nacelle%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel + t(3)*u2%TurbineComponents%Nacelle%RotationVel - t(2)*u3%TurbineComponents%Nacelle%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%RotationVel = u1%TurbineComponents%Nacelle%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%Position - u2%TurbineComponents%TailFin%Position) + t(2)**2*(-u1%TurbineComponents%TailFin%Position + u3%TurbineComponents%TailFin%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position + t(3)*u2%TurbineComponents%TailFin%Position - t(2)*u3%TurbineComponents%TailFin%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%Position = u1%TurbineComponents%TailFin%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation - u2%TurbineComponents%TailFin%Orientation) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation + u3%TurbineComponents%TailFin%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation + t(3)*u2%TurbineComponents%TailFin%Orientation - t(2)*u3%TurbineComponents%TailFin%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%Orientation = u1%TurbineComponents%TailFin%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel - u2%TurbineComponents%TailFin%TranslationVel) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel + u3%TurbineComponents%TailFin%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel + t(3)*u2%TurbineComponents%TailFin%TranslationVel - t(2)*u3%TurbineComponents%TailFin%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%TranslationVel = u1%TurbineComponents%TailFin%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel - u2%TurbineComponents%TailFin%RotationVel) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel + u3%TurbineComponents%TailFin%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel + t(3)*u2%TurbineComponents%TailFin%RotationVel - t(2)*u3%TurbineComponents%TailFin%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%RotationVel = u1%TurbineComponents%TailFin%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%Position - u2%TurbineComponents%Tower%Position) + t(2)**2*(-u1%TurbineComponents%Tower%Position + u3%TurbineComponents%Tower%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position + t(3)*u2%TurbineComponents%Tower%Position - t(2)*u3%TurbineComponents%Tower%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%Position = u1%TurbineComponents%Tower%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Tower%Orientation - u2%TurbineComponents%Tower%Orientation) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation + u3%TurbineComponents%Tower%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation + t(3)*u2%TurbineComponents%Tower%Orientation - t(2)*u3%TurbineComponents%Tower%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%Orientation = u1%TurbineComponents%Tower%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel - u2%TurbineComponents%Tower%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel + u3%TurbineComponents%Tower%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel + t(3)*u2%TurbineComponents%Tower%TranslationVel - t(2)*u3%TurbineComponents%Tower%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%TranslationVel = u1%TurbineComponents%Tower%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel - u2%TurbineComponents%Tower%RotationVel) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel + u3%TurbineComponents%Tower%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel + t(3)*u2%TurbineComponents%Tower%RotationVel - t(2)*u3%TurbineComponents%Tower%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%RotationVel = u1%TurbineComponents%Tower%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%Position - u2%TurbineComponents%SubStructure%Position) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position + u3%TurbineComponents%SubStructure%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position + t(3)*u2%TurbineComponents%SubStructure%Position - t(2)*u3%TurbineComponents%SubStructure%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%Position = u1%TurbineComponents%SubStructure%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation - u2%TurbineComponents%SubStructure%Orientation) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation + u3%TurbineComponents%SubStructure%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation + t(3)*u2%TurbineComponents%SubStructure%Orientation - t(2)*u3%TurbineComponents%SubStructure%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%Orientation = u1%TurbineComponents%SubStructure%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel - u2%TurbineComponents%SubStructure%TranslationVel) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel + u3%TurbineComponents%SubStructure%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel + t(3)*u2%TurbineComponents%SubStructure%TranslationVel - t(2)*u3%TurbineComponents%SubStructure%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%TranslationVel = u1%TurbineComponents%SubStructure%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel - u2%TurbineComponents%SubStructure%RotationVel) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel + u3%TurbineComponents%SubStructure%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel + t(3)*u2%TurbineComponents%SubStructure%RotationVel - t(2)*u3%TurbineComponents%SubStructure%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%RotationVel = u1%TurbineComponents%SubStructure%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%Position - u2%TurbineComponents%Foundation%Position) + t(2)**2*(-u1%TurbineComponents%Foundation%Position + u3%TurbineComponents%Foundation%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position + t(3)*u2%TurbineComponents%Foundation%Position - t(2)*u3%TurbineComponents%Foundation%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%Position = u1%TurbineComponents%Foundation%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation - u2%TurbineComponents%Foundation%Orientation) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation + u3%TurbineComponents%Foundation%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation + t(3)*u2%TurbineComponents%Foundation%Orientation - t(2)*u3%TurbineComponents%Foundation%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%Orientation = u1%TurbineComponents%Foundation%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel - u2%TurbineComponents%Foundation%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel + u3%TurbineComponents%Foundation%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel + t(3)*u2%TurbineComponents%Foundation%TranslationVel - t(2)*u3%TurbineComponents%Foundation%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%TranslationVel = u1%TurbineComponents%Foundation%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel - u2%TurbineComponents%Foundation%RotationVel) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel + u3%TurbineComponents%Foundation%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel + t(3)*u2%TurbineComponents%Foundation%RotationVel - t(2)*u3%TurbineComponents%Foundation%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%RotationVel = u1%TurbineComponents%Foundation%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b0 * t_out + c0 * t_out**2 + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%Position(i1) + u3%TurbineComponents%Hub%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position(i1) + t(3)*u2%TurbineComponents%Hub%Position(i1) - t(2)*u3%TurbineComponents%Hub%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation(i1,i2) + u3%TurbineComponents%Hub%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Hub%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Hub%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel(i1) + u3%TurbineComponents%Hub%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel(i1) + t(3)*u2%TurbineComponents%Hub%TranslationVel(i1) - t(2)*u3%TurbineComponents%Hub%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel(i1) + u3%TurbineComponents%Hub%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel(i1) + t(3)*u2%TurbineComponents%Hub%RotationVel(i1) - t(2)*u3%TurbineComponents%Hub%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position(i1) + u3%TurbineComponents%RotorFurl%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position(i1) + t(3)*u2%TurbineComponents%RotorFurl%Position(i1) - t(2)*u3%TurbineComponents%RotorFurl%Position(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + u3%TurbineComponents%RotorFurl%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + t(3)*u2%TurbineComponents%RotorFurl%Orientation(i1,i2) - t(2)*u3%TurbineComponents%RotorFurl%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel(i1) + u3%TurbineComponents%RotorFurl%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel(i1) + u3%TurbineComponents%RotorFurl%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%RotationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position(i1) + u3%TurbineComponents%Nacelle%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position(i1) + t(3)*u2%TurbineComponents%Nacelle%Position(i1) - t(2)*u3%TurbineComponents%Nacelle%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation(i1,i2) + u3%TurbineComponents%Nacelle%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Nacelle%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Nacelle%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel(i1) + u3%TurbineComponents%Nacelle%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%TranslationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel(i1) + u3%TurbineComponents%Nacelle%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%RotationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%Position(i1) + u3%TurbineComponents%TailFin%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position(i1) + t(3)*u2%TurbineComponents%TailFin%Position(i1) - t(2)*u3%TurbineComponents%TailFin%Position(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation(i1,i2) + u3%TurbineComponents%TailFin%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation(i1,i2) + t(3)*u2%TurbineComponents%TailFin%Orientation(i1,i2) - t(2)*u3%TurbineComponents%TailFin%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel(i1) + u3%TurbineComponents%TailFin%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel(i1) + t(3)*u2%TurbineComponents%TailFin%TranslationVel(i1) - t(2)*u3%TurbineComponents%TailFin%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel(i1) + u3%TurbineComponents%TailFin%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel(i1) + t(3)*u2%TurbineComponents%TailFin%RotationVel(i1) - t(2)*u3%TurbineComponents%TailFin%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%Position(i1) + u3%TurbineComponents%Tower%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position(i1) + t(3)*u2%TurbineComponents%Tower%Position(i1) - t(2)*u3%TurbineComponents%Tower%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation(i1,i2) + u3%TurbineComponents%Tower%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Tower%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Tower%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel(i1) + u3%TurbineComponents%Tower%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel(i1) + t(3)*u2%TurbineComponents%Tower%TranslationVel(i1) - t(2)*u3%TurbineComponents%Tower%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel(i1) + u3%TurbineComponents%Tower%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel(i1) + t(3)*u2%TurbineComponents%Tower%RotationVel(i1) - t(2)*u3%TurbineComponents%Tower%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position(i1) + u3%TurbineComponents%SubStructure%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position(i1) + t(3)*u2%TurbineComponents%SubStructure%Position(i1) - t(2)*u3%TurbineComponents%SubStructure%Position(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation(i1,i2) + u3%TurbineComponents%SubStructure%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation(i1,i2) + t(3)*u2%TurbineComponents%SubStructure%Orientation(i1,i2) - t(2)*u3%TurbineComponents%SubStructure%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel(i1) + u3%TurbineComponents%SubStructure%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%TranslationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel(i1) + u3%TurbineComponents%SubStructure%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%RotationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%Position(i1) + u3%TurbineComponents%Foundation%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position(i1) + t(3)*u2%TurbineComponents%Foundation%Position(i1) - t(2)*u3%TurbineComponents%Foundation%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation(i1,i2) + u3%TurbineComponents%Foundation%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Foundation%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Foundation%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel(i1) + u3%TurbineComponents%Foundation%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel(i1) + t(3)*u2%TurbineComponents%Foundation%TranslationVel(i1) - t(2)*u3%TurbineComponents%Foundation%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel(i1) + u3%TurbineComponents%Foundation%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel(i1) + t(3)*u2%TurbineComponents%Foundation%RotationVel(i1) - t(2)*u3%TurbineComponents%Foundation%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) * scaleFactor + u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b + c * t_out IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - ALLOCATE(b2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - ALLOCATE(c2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - b2 = (t(3)**2*(u1%MulTabLoc - u2%MulTabLoc) + t(2)**2*(-u1%MulTabLoc + u3%MulTabLoc))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%MulTabLoc + t(3)*u2%MulTabLoc - t(2)*u3%MulTabLoc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%MulTabLoc = u1%MulTabLoc + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) + DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) + b = (t(3)**2*(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + t(2)**2*(-u1%MulTabLoc(i1,i2) + u3%MulTabLoc(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%MulTabLoc(i1,i2) + t(3)*u2%MulTabLoc(i1,i2) - t(2)*u3%MulTabLoc(i1,i2) ) * scaleFactor + u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - ALLOCATE(b2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - ALLOCATE(c2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - b2 = (t(3)**2*(u1%InflowVelocity - u2%InflowVelocity) + t(2)**2*(-u1%InflowVelocity + u3%InflowVelocity))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%InflowVelocity + t(3)*u2%InflowVelocity - t(2)*u3%InflowVelocity ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowVelocity = u1%InflowVelocity + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) + DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) + b = (t(3)**2*(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + t(2)**2*(-u1%InflowVelocity(i1,i2) + u3%InflowVelocity(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowVelocity(i1,i2) + t(3)*u2%InflowVelocity(i1,i2) - t(2)*u3%InflowVelocity(i1,i2) ) * scaleFactor + u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%AvgInfVel,1))) - ALLOCATE(c1(SIZE(u_out%AvgInfVel,1))) - b1 = (t(3)**2*(u1%AvgInfVel - u2%AvgInfVel) + t(2)**2*(-u1%AvgInfVel + u3%AvgInfVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%AvgInfVel + t(3)*u2%AvgInfVel - t(2)*u3%AvgInfVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AvgInfVel = u1%AvgInfVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) + b = (t(3)**2*(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + t(2)**2*(-u1%AvgInfVel(i1) + u3%AvgInfVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%AvgInfVel(i1) + t(3)*u2%AvgInfVel(i1) - t(2)*u3%AvgInfVel(i1) ) * scaleFactor + u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b + c * t_out + END DO END SUBROUTINE AD14_Input_ExtrapInterp2 @@ -16993,11 +16800,12 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -17010,9 +16818,11 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i01 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp1(y1%OutputLoads(i01), y2%OutputLoads(i01), tin, y_out%OutputLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -17047,12 +16857,14 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -17071,9 +16883,11 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i01 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp2(y1%OutputLoads(i01), y2%OutputLoads(i01), y3%OutputLoads(i01), tin, y_out%OutputLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated diff --git a/modules/aerodyn14/src/AeroSubs.f90 b/modules/aerodyn14/src/AeroSubs.f90 index c6141806c5..3ca457193a 100644 --- a/modules/aerodyn14/src/AeroSubs.f90 +++ b/modules/aerodyn14/src/AeroSubs.f90 @@ -385,7 +385,6 @@ SUBROUTINE AD14_GetInput(InitInp, P, x, xd, z, m, y, ErrStat, ErrMess ) END IF - ! Read in the air density CALL ReadVar( UnIn, InitInp%ADFileName, P%Wind%Rho, VarName='Rho', VarDescr='Air density', ErrStat=ErrStat, ErrMsg=ErrMess) IF (ErrStat >= AbortErrLev) THEN @@ -1619,18 +1618,13 @@ SUBROUTINE READTwr(UnIn, InitInp, P, x, xd, z, m, y, ErrStat, ErrMess ) END SUBROUTINE READTwr -! Dynamics Program aerodynamics force interface gateway - ! **************************************************** - SUBROUTINE ELEMFRC(P, m, ErrStat, ErrMess, & - PSI, RLOCAL, J, IBlade, VNROTOR2, VT, VNW, & - VNB, DFN, DFT, PMA, Initial) -! SUBROUTINE ELEMFRC (PSI, RLOCAL, J, IBlade, VNROTOR2, VT, VNW, & -! VNB, DFN, DFT, PMA, Initial) - ! **************************************************** - ! calculates the aerodynamic forces on one - ! blade element. Inputs include all velocities. - ! Normal and tangential forces and 'A' are returned. !==================================================================================================== +!> Calculates the axial and tangential induction factor for each annular segment +! and time step (i.e. sets m%Element%A and m%Element%AP) + SUBROUTINE ELEM_INDUCTIONS( p, m, ErrStat, ErrMess, & + PSI, RLOCAL, J, IBlade, VNROTOR2, VT, VNW, & + VNB, Initial) + IMPLICIT NONE ! Passed Variables: TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters @@ -1638,102 +1632,97 @@ SUBROUTINE ELEMFRC(P, m, ErrStat, ErrMess, & INTEGER, INTENT(OUT) :: ErrStat CHARACTER(*), INTENT(OUT) :: ErrMess - REAL(ReKi),INTENT(OUT) :: DFN - REAL(ReKi),INTENT(OUT) :: DFT - REAL(ReKi),INTENT(OUT) :: PMA REAL(ReKi),INTENT(IN) :: PSI REAL(ReKi),INTENT(IN) :: RLOCAL - REAL(ReKi),INTENT(IN) :: VNB + REAL(ReKi), INTENT(IN ) :: VNB ! Normal (relative) velocity of the element REAL(ReKi),INTENT(IN) :: VNROTOR2 REAL(ReKi),INTENT(IN) :: VNW - REAL(ReKi),INTENT(INOUT) :: VT + REAL(ReKi), INTENT(IN ) :: VT INTEGER, INTENT(IN) :: J INTEGER, INTENT(IN) :: IBlade LOGICAL, INTENT(IN) :: Initial - ! Local Variables: - - REAL(ReKi) :: CDA - REAL(ReKi) :: CLA - REAL(ReKi) :: CMA - REAL(ReKi) :: CPHI - REAL(ReKi) :: PHI - REAL(ReKi) :: QA - REAL(ReKi) :: ReNum - REAL(ReKi) :: SPHI - REAL(ReKi) :: Vinduced - REAL(ReKi) :: VN - INTEGER :: ErrStatLcL ! Error status returned by called routines. CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. ErrStat = ErrID_None ErrMess = "" - - ! initialize TanInd variables -m%Element%A (J,IBLADE) = 0.0 -m%Element%AP(J,IBLADE) = 0.0 - - !-mlb Check for being at the center of rotation. ! If we are at the center of rotation, the induction equations ! are undefined, so let's just USE zeros. - -IF ( RLOCAL < 0.01 ) THEN +! initialize AxInd and TanInd variables m%Element%A (J,IBLADE) = 0.0 m%Element%AP(J,IBLADE) = 0.0 + +IF ( RLOCAL < 0.01 ) THEN + ! Already set to 0 ELSEIF( P%DYNINFL .AND. P%Blade%R * m%Rotor%REVS < 2.0 ) THEN !ACH 3/10/03 This block deals with dyn. inflow problems at low tip speed - m%Element%A (J,IBLADE) = 0.0 - m%Element%AP(J,IBLADE) = 0.0 + ! Already set to 0 m%DYNINIT = .TRUE. !Re-initialize if we begin using dynamic inflow again ELSE ! Turn wake off when using dynamic inflow and tip speed goes low. Wake will remain off. - ! Get induction factor = A using static airfoil coefficients IF ( P%WAKE .AND. .NOT. Initial) THEN IF ( P%DYNINFL ) THEN ! USE dynamic inflow model to find A CALL VINDINF( P, m, ErrStatLcl, ErrMessLcl, & - J, IBlade, RLOCAL, VNW, VNB, VT, PSI ) !possibly changes VT, A, and AP - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) + J, IBlade, RLOCAL, VNW, VNB, VT, PSI ) !possibly changes A, and AP + CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEM_INDUCTIONS' ) IF (ErrStat >= AbortErrLev) RETURN ELSE ! USE momentum balance to find A CALL VIND( P, m, ErrStatLcl, ErrMessLcl, & - J, IBlade, RLOCAL, VNROTOR2, VNW, VNB, VT ) !changes VT, A, and AP - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) + J, IBlade, RLOCAL, VNROTOR2, VNW, VNB, VT ) !changes A, and AP + CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEM_INDUCTIONS' ) IF (ErrStat >= AbortErrLev) RETURN ! Apply skewed-wake correction, if applicable IF( m%SKEW ) CALL VNMOD( P, m, ErrStatLcl, ErrMessLcl,& J, IBlade, RLOCAL, PSI ) !changes A - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) + CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEM_INDUCTIONS' ) IF (ErrStat >= AbortErrLev) RETURN ENDIF - ELSE - ! Ignore the wake calculation entirely - m%Element%A (J,IBLADE) = 0.0 - m%Element%AP(J,IBLADE) = 0.0 ENDIF - ENDIF -Vinduced = VNW * m%Element%A(J,IBLADE) -VN = VNW + VNB - Vinduced +END SUBROUTINE ELEM_INDUCTIONS + +SUBROUTINE ELEMFRC2( p, m, ErrStat, ErrMess, J, IBlade, & + DFN, DFT, PMA, Initial, phi ) -m%InducedVel%SumInfl = m%InducedVel%SumInfl + Vinduced * RLOCAL * p%Blade%DR(J) + IMPLICIT NONE + ! Passed Variables: + TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters + TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables + INTEGER, INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMess + + REAL(ReKi), INTENT( OUT) :: DFN + REAL(ReKi), INTENT( OUT) :: DFT + REAL(ReKi), INTENT( OUT) :: PMA + INTEGER, INTENT(IN) :: J + INTEGER, INTENT(IN) :: IBlade + LOGICAL, INTENT(IN) :: Initial - ! Get the angle of attack + ! Local Variables: -PHI = ATAN2( VN, VT ) -m%Element%ALPHA(J,IBlade) = PHI - m%Element%PITNOW + REAL(ReKi) :: CDA + REAL(ReKi) :: CLA + REAL(ReKi) :: CMA + REAL(ReKi) :: CPHI + REAL(ReKi), intent(in) :: PHI + REAL(ReKi) :: QA + REAL(ReKi) :: ReNum + REAL(ReKi) :: SPHI -CALL MPI2PI ( m%Element%ALPHA(J,IBlade) ) + INTEGER :: ErrStatLcL ! Error status returned by called routines. + CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. -m%Element%W2(J,IBlade) = VN * VN + VT * VT + ErrStat = ErrID_None + ErrMess = "" ! Get the Reynold's number for the element ! Returns Reynold's number x 10^6 !bjj: Reynold's number x 10^-6 ? @@ -1799,22 +1788,22 @@ SUBROUTINE ELEMFRC(P, m, ErrStat, ErrMess, & m%ElOut%DFNSAV ( m%ElOut%ElPrList(J) ) = DFN m%ElOut%DFTSAV ( m%ElOut%ElPrList(J) ) = DFT m%ElOut%DynPres( m%ElOut%ElPrList(J) ) = 0.5 * P%Wind%RHO * m%Element%W2(J,IBlade) - m%ElOut%PITSAV ( m%ElOut%ElPrList(J) ) = m%Element%PITNOW * R2D + m%ElOut%PITSAV ( m%ElOut%ElPrList(J) ) = m%Element%PitNow(J,IBlade) * R2D m%ElOut%PMM ( m%ElOut%ElPrList(J) ) = PMA m%ElOut%ReyNum ( m%ElOut%ElPrList(J) ) = ReNum + m%ElOut%Gamma ( m%ElOut%ElPrList(J) ) = 0.5 * P%Blade%C(J) * sqrt(m%Element%W2(J,IBlade)) * CLA ! 1/2 c Urel Cl [m^2/s] ENDIF ENDIF RETURN -END SUBROUTINE ELEMFRC +END SUBROUTINE ELEMFRC2 !====================================================== - SUBROUTINE VIND( P, m, ErrStat, ErrMess, & + SUBROUTINE VIND( p, m, ErrStat, ErrMess, & J, IBlade, RLOCAL, VNROTOR2, VNW, VNB, VT ) -! SUBROUTINE VIND( J, IBlade, RLOCAL, VNROTOR2, VNW, VNB, VT ) - ! calculates the axial induction factor for each - ! annular segment and time step. + ! Calculates the axial and tangential induction factor for each annular segment + ! and time step (i.e. sets m%Element%A and m%Element%AP) ! *************************************************** IMPLICIT NONE ! Passed Variables: @@ -1825,7 +1814,7 @@ SUBROUTINE VIND( P, m, ErrStat, ErrMess, & REAL(ReKi), INTENT(IN ) :: VNB REAL(ReKi), INTENT(IN ) :: VNROTOR2 REAL(ReKi), INTENT(IN ) :: VNW - REAL(ReKi), INTENT(INOUT) :: VT + REAL(ReKi), INTENT(IN ) :: VT ! tangential velocity from relative blade motion and wind, no induction INTEGER, INTENT(IN ) :: J INTEGER, INTENT(IN ) :: IBlade @@ -1912,12 +1901,12 @@ SUBROUTINE VIND( P, m, ErrStat, ErrMess, & IF ( ABS( VNB ) > 100. ) THEN m%Element%A( J, IBLADE ) = 0.0 - CALL VINDERR( P, m, ErrStat, ErrMess, & + CALL VINDERR( m, ErrStat, ErrMess, & VNW, VNB, 'VNB', J, IBLADE ) RETURN ELSEIF ( ABS( VT ) > 400. ) THEN m%Element%A( J, IBLADE ) = 0.0 - CALL VINDERR( P, m, ErrStat, ErrMess, & + CALL VINDERR( m, ErrStat, ErrMess, & VNW, VT, 'VT', J, IBLADE ) RETURN ENDIF @@ -1926,7 +1915,7 @@ SUBROUTINE VIND( P, m, ErrStat, ErrMess, & CALL AXIND ( P, m, ErrStat, ErrMess, & VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, A2P, & - J, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) + J, IBlade, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) IF (ErrStat >= AbortErrLev) RETURN DAI = A2 - AI @@ -1946,7 +1935,7 @@ SUBROUTINE VIND( P, m, ErrStat, ErrMess, & CALL AXIND ( P, m, ErrStatLcl, ErrMessLcl, & VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, A2P, & - J, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) + J, IBlade, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,'VIND' ) IF (ErrStat >= AbortErrLev) RETURN @@ -1979,7 +1968,6 @@ SUBROUTINE VIND( P, m, ErrStat, ErrMess, & ! Passed test, we're done m%Element%A (J,IBLADE) = A2 m%Element%AP(J,IBLADE) = A2P -VT = VT * ( 1. + A2P ) !bjj: why are we changing the total velocity? m%Element%OLD_A_NS (J,IBLADE) = A2 m%Element%OLD_AP_NS (J,IBLADE) = A2P @@ -1988,7 +1976,7 @@ END SUBROUTINE VIND ! *************************************************** - SUBROUTINE VINDERR( P, m, ErrStat, ErrMess, & + SUBROUTINE VINDERR( m, ErrStat, ErrMess, & VNW, VX, VID, J, IBLADE ) ! SUBROUTINE VINDERR( VNW, VX, VID, J, IBLADE ) ! used to write warning messages to the screen @@ -1996,7 +1984,6 @@ SUBROUTINE VINDERR( P, m, ErrStat, ErrMess, & ! *************************************************** IMPLICIT NONE ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables INTEGER, INTENT(OUT) :: ErrStat CHARACTER(*), INTENT(OUT) :: ErrMess @@ -2036,7 +2023,7 @@ END SUBROUTINE VINDERR ! ****************************************************** SUBROUTINE AXIND (P, m, ErrStat, ErrMess, & VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, & - A2P, J, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) + A2P, J, IBlade, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) ! SUBROUTINE AXIND ( VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, & ! A2P, J, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) ! calculates a new axial induction factor from @@ -2068,6 +2055,7 @@ SUBROUTINE AXIND (P, m, ErrStat, ErrMess, & REAL(ReKi),INTENT(OUT) :: VTA INTEGER ,INTENT(IN) :: J + INTEGER ,INTENT(IN) :: IBlade ! Local Variables: @@ -2087,7 +2075,7 @@ SUBROUTINE AXIND (P, m, ErrStat, ErrMess, & ! Get airfoil CL and CD PHI = ATAN2( VNA, VTA ) -ALPHA = PHI - m%Element%PITNOW +ALPHA = PHI - m%Element%PitNow(J,IBlade) CALL MPI2PI ( ALPHA ) @@ -4114,16 +4102,16 @@ SUBROUTINE GetRM ( P, m, ErrStat, ErrMess, & !+++++++++++++++++++++++++++++++++++++++++++++++++++++ !Suzuki's method !DO mode = MaxInflo+1, maxInfl -! m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode ) * COS( REAL(MRvector(mode)) * psiBar ) -! m%DynInflow%RMS_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode ) * SIN( REAL(MRvector(mode)) * psiBar ) +! m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode ) * COS( REAL(MRvector(mode), ReKi) * psiBar ) +! m%DynInflow%RMS_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode ) * SIN( REAL(MRvector(mode), ReKi) * psiBar ) !END DO ! mode ! Shawler's method DO mode = p%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) * COS( REAL(MRvector(mode)) * WindPsi ) + m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) * COS( REAL(MRvector(mode), ReKi) * WindPsi ) CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'GetRM' ) IF (ErrStat >= AbortErrLev) RETURN - m%DynInflow%RMS_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) * SIN( REAL(MRvector(mode)) * WindPsi ) + m%DynInflow%RMS_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) * SIN( REAL(MRvector(mode), ReKi) * WindPsi ) CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'GetRM' ) IF (ErrStat >= AbortErrLev) RETURN @@ -4738,10 +4726,11 @@ SUBROUTINE infdist( P, m, ErrStat, ErrMess ) END SUBROUTINE infdist ! ************************************************************* - SUBROUTINE vindinf( P, m, ErrStat, ErrMess, & + SUBROUTINE VINDINF( P, m, ErrStat, ErrMess, & iradius, iblade, rlocal, vnw, VNB, VT, psi ) - ! vindinf calculates the axial induction factor for each - ! element position using the calculated inflow parameters. + ! Calculates the axial and tangential induction factor for each annular segment + ! and time step (i.e. sets m%Element%A and m%Element%AP) + ! Uses the calculated inflow parameters ! Called by ElemFrc for each element at a new time step. ! ************************************************************* @@ -4757,7 +4746,7 @@ SUBROUTINE vindinf( P, m, ErrStat, ErrMess, & REAL(ReKi),INTENT(IN) :: rlocal REAL(ReKi),INTENT(IN) :: VNB REAL(ReKi),INTENT(IN) :: vnw - REAL(ReKi),INTENT(INOUT) :: VT + REAL(ReKi),INTENT(IN ) :: VT ! Tangential velocity from relative blade motion and wind, no induction INTEGER, INTENT(IN) :: iradius INTEGER, INTENT(IN) :: iblade @@ -4801,7 +4790,7 @@ SUBROUTINE vindinf( P, m, ErrStat, ErrMess, & DO mode = 1, p%DynInflow%MaxInflo m%Element%A(iRadius,iBlade) = m%Element%A(iRadius,iBlade) & + xphi(Rzero,mode,ErrStatLcl, ErrMessLcl) * m%DynInflow%xAlpha(mode) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'vindinf' ) + CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'VINDINF' ) IF (ErrStat >= AbortErrLev) RETURN ! & + phis(Rzero, MRvector(mode), NJvector(mode) )* xAlpha(mode) @@ -4812,15 +4801,15 @@ SUBROUTINE vindinf( P, m, ErrStat, ErrMess, & !DO mode = MaxInflo+1, maxInfl ! A(iRadius,iBlade) = A(iRadius,iBlade) + xphi(Rzero,mode) * & !! & + phis(Rzero, MRvector(mode), NJvector(mode) ) * -! ( xAlpha(mode) * COS( REAL(MRvector(MODE)) * psibar ) & -! + xBeta (mode) * SIN( REAL(MRvector(MODE)) * psibar ) ) +! ( xAlpha(mode) * COS( REAL(MRvector(MODE), ReKi) * psibar ) & +! + xBeta (mode) * SIN( REAL(MRvector(MODE), ReKi) * psibar ) ) !END DO !mode ! Shawler: DO mode = p%DynInflow%MaxInflo+1, maxInfl m%Element%A(iRadius,iBlade) = m%Element%A(iRadius,iBlade) + xphi(Rzero,mode,ErrStatLcl, ErrMessLcl) * & - ( m%DynInflow%xAlpha(mode) * COS( REAL(MRvector(MODE)) * Windpsi ) & - + m%DynInflow%xBeta (mode) * SIN( REAL(MRvector(MODE)) * Windpsi ) ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'vindinf' ) + ( m%DynInflow%xAlpha(mode) * COS( REAL(MRvector(MODE), ReKi) * Windpsi ) & + + m%DynInflow%xBeta (mode) * SIN( REAL(MRvector(MODE), ReKi) * Windpsi ) ) + CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'VINDINF' ) IF (ErrStat >= AbortErrLev) RETURN END DO !mode @@ -4832,13 +4821,14 @@ SUBROUTINE vindinf( P, m, ErrStat, ErrMess, & ! Calculate induced swirl (a') if desired. +m%Element%AP(iRadius,iBlade) = 0.0_ReKi ! Default value + IF ( P%SWIRL ) THEN ! akihiro 10/26/99 SWRLARG = 1.0 + 4.0 * m%Element%A(iradius,iblade) * VNW * & ( (1.0 - m%Element%A(iradius,iblade)) * VNW + VNB ) / VT / VT IF ( SWRLARG > 0.0 ) THEN A2P = 0.5 * ( -1.0 + SQRT( SWRLARG ) ) - VT = VT * ( 1.0 + A2P) ! bjj: this value was not properly set before. We could also just replace the local A2P variable with AP() instead. m%Element%AP(iRadius,iBlade) = A2P ENDIF @@ -4846,7 +4836,7 @@ SUBROUTINE vindinf( P, m, ErrStat, ErrMess, & ENDIF RETURN -END SUBROUTINE vindinf +END SUBROUTINE VINDINF ! *********************************************************************** SUBROUTINE ABPRECOR( F, OLDF, DFDT, DT, N, N0 ) @@ -5190,14 +5180,14 @@ FUNCTION FGAMMA( R, J, M, N ) IF ( MOD(R+M,2) == 0 ) THEN FGAMMA = (-1)**((N+J-2*R)*.5) * 2. & - * SQRT( REAL( (2*N+1) * (2*J+1) ) ) & + * SQRT( REAL( (2*N+1) * (2*J+1), ReKi ) ) & / SQRT( HFUNC(M,N) * HFUNC(R,J) ) & - / REAL( (J+N) * (J+N+2) * ((J-N)*(J-N)-1) ) + / REAL( (J+N) * (J+N+2) * ((J-N)*(J-N)-1), ReKi ) ELSE IF ( ABS(J-N) == 1 ) THEN !bjj: why don't we use the pi() variable? or PibyTwo - FGAMMA = 3.14159265 * SIGN(1., REAL(R-M) ) * .5 & + FGAMMA = 3.14159265 * SIGN(1., REAL(R-M, ReKi) ) * .5 & / SQRT( HFUNC(M,N) * HFUNC(R,J) ) & - / SQRT( REAL( (2*N+1) * (2*J+1) ) ) + / SQRT( REAL( (2*N+1) * (2*J+1) , ReKi) ) ELSE FGAMMA = 0. @@ -5245,8 +5235,8 @@ FUNCTION HFUNC( M, N ) NPM = N + M NMM = N - M -HFUNC = ( REAL( IDUBFACT(NPM-1) ) / REAL( IDUBFACT(NPM) ) ) & - * ( REAL( IDUBFACT(NMM-1) ) / REAL( IDUBFACT(NMM) ) ) +HFUNC = ( REAL( IDUBFACT(NPM-1), ReKi ) / REAL( IDUBFACT(NPM), ReKi ) ) & + * ( REAL( IDUBFACT(NMM-1), ReKi ) / REAL( IDUBFACT(NMM), ReKi ) ) @@ -5390,11 +5380,11 @@ FUNCTION phis( Rzero, r, j ) DO q = r, j-1, 2 phis = phis & - + Rzero ** q * (-1.) **((q-r)/2) * REAL( idubfact(j+q) ) & - / REAL( idubfact(q-r) * idubfact(q+r) * idubfact(j-q-1) ) + + Rzero ** q * (-1.) **((q-r)/2) * REAL( idubfact(j+q), ReKi ) & + / REAL( idubfact(q-r) * idubfact(q+r) * idubfact(j-q-1), ReKi ) END DO !q -phis = phis * SQRT( REAL( 2*j+1 ) * hfunc(r,j) ) +phis = phis * SQRT( REAL( 2*j+1, ReKi ) * hfunc(r,j) ) RETURN diff --git a/modules/aerodyn14/src/DWM.f90 b/modules/aerodyn14/src/DWM.f90 index f02732e3c7..2889057e3c 100644 --- a/modules/aerodyn14/src/DWM.f90 +++ b/modules/aerodyn14/src/DWM.f90 @@ -65,14 +65,11 @@ SUBROUTINE DWM_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu CALL NWTC_Init( ) ! Display the module information - - !CALL DispNVD( DWM__Ver ) - - ! read the wind file for DWM - CALL WrScr('') CALL DispNVD(DWM_Ver) + ! read the wind file for DWM + CALL WrScr(" Reading the wind file for DWM simulation." ) ! InitInp%IfW%InputFileName is already set in FAST diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index f18608cc83..0678240e6c 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -432,12 +432,12 @@ SUBROUTINE DWM_PackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Denominator - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Numerator - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Denominator + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Numerator + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackCVSD SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -453,12 +453,6 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -476,12 +470,12 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%counter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Denominator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Numerator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%counter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Denominator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Numerator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackCVSD SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -670,8 +664,10 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array_temp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%average_velocity_array_temp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%average_velocity_array_temp))-1 ) = PACK(InData%average_velocity_array_temp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%average_velocity_array_temp) + DO i1 = LBOUND(InData%average_velocity_array_temp,1), UBOUND(InData%average_velocity_array_temp,1) + ReKiBuf(Re_Xferred) = InData%average_velocity_array_temp(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%average_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -683,8 +679,10 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%average_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%average_velocity_array))-1 ) = PACK(InData%average_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%average_velocity_array) + DO i1 = LBOUND(InData%average_velocity_array,1), UBOUND(InData%average_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%average_velocity_array(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%swept_area) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -696,11 +694,13 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%swept_area,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%swept_area)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%swept_area))-1 ) = PACK(InData%swept_area,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%swept_area) + DO i1 = LBOUND(InData%swept_area,1), UBOUND(InData%swept_area,1) + ReKiBuf(Re_Xferred) = InData%swept_area(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_velocity - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_velocity + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%time_step_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -711,13 +711,15 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%time_step_velocity_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%time_step_velocity_array)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%time_step_velocity_array))-1 ) = PACK(InData%time_step_velocity_array,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%time_step_velocity_array) + DO i1 = LBOUND(InData%time_step_velocity_array,1), UBOUND(InData%time_step_velocity_array,1) + IntKiBuf(Int_Xferred) = InData%time_step_velocity_array(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_pass_velocity - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_force - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_pass_velocity + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_force + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packturbine_average_velocity_data SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -733,12 +735,6 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -766,15 +762,10 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%average_velocity_array_temp)>0) OutData%average_velocity_array_temp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%average_velocity_array_temp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%average_velocity_array_temp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%average_velocity_array_temp,1), UBOUND(OutData%average_velocity_array_temp,1) + OutData%average_velocity_array_temp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -789,15 +780,10 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%average_velocity_array)>0) OutData%average_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%average_velocity_array))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%average_velocity_array) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%average_velocity_array,1), UBOUND(OutData%average_velocity_array,1) + OutData%average_velocity_array(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! swept_area not allocated Int_Xferred = Int_Xferred + 1 @@ -812,18 +798,13 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%swept_area)>0) OutData%swept_area = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%swept_area))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%swept_area) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%swept_area,1), UBOUND(OutData%swept_area,1) + OutData%swept_area(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%time_step_velocity = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%time_step_velocity = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! time_step_velocity_array not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -837,20 +818,15 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%time_step_velocity_array)>0) OutData%time_step_velocity_array = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%time_step_velocity_array))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%time_step_velocity_array) - DEALLOCATE(mask1) - END IF - OutData%time_step_pass_velocity = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%time_step_force = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%time_step_velocity_array,1), UBOUND(OutData%time_step_velocity_array,1) + OutData%time_step_velocity_array(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%time_step_pass_velocity = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%time_step_force = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackturbine_average_velocity_data SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -976,10 +952,10 @@ SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%np_x - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X_length - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%np_x + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X_length + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Turb_Stress_DWM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -993,15 +969,19 @@ SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Turb_Stress_DWM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Turb_Stress_DWM))-1 ) = PACK(InData%Turb_Stress_DWM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Turb_Stress_DWM) + DO i2 = LBOUND(InData%Turb_Stress_DWM,2), UBOUND(InData%Turb_Stress_DWM,2) + DO i1 = LBOUND(InData%Turb_Stress_DWM,1), UBOUND(InData%Turb_Stress_DWM,1) + ReKiBuf(Re_Xferred) = InData%Turb_Stress_DWM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_x_vector - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_r_vector - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ppR - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_x_vector + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_r_vector + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ppR + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackWake_Deficit_Data SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1017,12 +997,6 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1038,10 +1012,10 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%np_x = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%X_length = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%np_x = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%X_length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turb_Stress_DWM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1058,22 +1032,19 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Turb_Stress_DWM)>0) OutData%Turb_Stress_DWM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Turb_Stress_DWM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Turb_Stress_DWM) - DEALLOCATE(mask2) - END IF - OutData%n_x_vector = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_r_vector = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ppR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%Turb_Stress_DWM,2), UBOUND(OutData%Turb_Stress_DWM,2) + DO i1 = LBOUND(OutData%Turb_Stress_DWM,1), UBOUND(OutData%Turb_Stress_DWM,1) + OutData%Turb_Stress_DWM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%n_x_vector = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_r_vector = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ppR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackWake_Deficit_Data SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) @@ -1169,10 +1140,10 @@ SUBROUTINE DWM_PackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%scale_factor - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%moving_time - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%scale_factor + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%moving_time + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_PackMeanderData SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1188,12 +1159,6 @@ SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackMeanderData' @@ -1207,10 +1172,10 @@ SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%scale_factor = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%moving_time = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%scale_factor = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%moving_time = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackMeanderData SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,8 +1601,8 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SimulationOrder_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SimulationOrder_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Turbine_sort_order) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1648,11 +1613,13 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine_sort_order,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Turbine_sort_order)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Turbine_sort_order))-1 ) = PACK(InData%Turbine_sort_order,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Turbine_sort_order) + DO i1 = LBOUND(InData%Turbine_sort_order,1), UBOUND(InData%Turbine_sort_order,1) + IntKiBuf(Int_Xferred) = InData%Turbine_sort_order(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WT_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WT_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TurbineInfluenceData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1666,8 +1633,12 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TurbineInfluenceData)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TurbineInfluenceData))-1 ) = PACK(InData%TurbineInfluenceData,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TurbineInfluenceData) + DO i2 = LBOUND(InData%TurbineInfluenceData,2), UBOUND(InData%TurbineInfluenceData,2) + DO i1 = LBOUND(InData%TurbineInfluenceData,1), UBOUND(InData%TurbineInfluenceData,1) + IntKiBuf(Int_Xferred) = InData%TurbineInfluenceData(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_index) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1679,8 +1650,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_index,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_index)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%upwind_turbine_index))-1 ) = PACK(InData%upwind_turbine_index,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%upwind_turbine_index) + DO i1 = LBOUND(InData%upwind_turbine_index,1), UBOUND(InData%upwind_turbine_index,1) + IntKiBuf(Int_Xferred) = InData%upwind_turbine_index(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_index) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1692,13 +1665,15 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_index,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_index)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%downwind_turbine_index))-1 ) = PACK(InData%downwind_turbine_index,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%downwind_turbine_index) + DO i1 = LBOUND(InData%downwind_turbine_index,1), UBOUND(InData%downwind_turbine_index,1) + IntKiBuf(Int_Xferred) = InData%downwind_turbine_index(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%upwindturbine_number - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%downwindturbine_number - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%upwindturbine_number + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%downwindturbine_number + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%turbine_windorigin_length) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1709,8 +1684,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_windorigin_length,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_windorigin_length)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_windorigin_length))-1 ) = PACK(InData%turbine_windorigin_length,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_windorigin_length) + DO i1 = LBOUND(InData%turbine_windorigin_length,1), UBOUND(InData%turbine_windorigin_length,1) + ReKiBuf(Re_Xferred) = InData%turbine_windorigin_length(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1722,8 +1699,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_projected_distance,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_projected_distance)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_projected_distance))-1 ) = PACK(InData%upwind_turbine_projected_distance,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_projected_distance) + DO i1 = LBOUND(InData%upwind_turbine_projected_distance,1), UBOUND(InData%upwind_turbine_projected_distance,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_projected_distance(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1735,8 +1714,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_projected_distance,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_projected_distance)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_projected_distance))-1 ) = PACK(InData%downwind_turbine_projected_distance,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_projected_distance) + DO i1 = LBOUND(InData%downwind_turbine_projected_distance,1), UBOUND(InData%downwind_turbine_projected_distance,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_projected_distance(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%turbine_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1751,8 +1732,12 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_angle))-1 ) = PACK(InData%turbine_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_angle) + DO i2 = LBOUND(InData%turbine_angle,2), UBOUND(InData%turbine_angle,2) + DO i1 = LBOUND(InData%turbine_angle,1), UBOUND(InData%turbine_angle,1) + ReKiBuf(Re_Xferred) = InData%turbine_angle(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_align_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1764,8 +1749,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_align_angle,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_align_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_align_angle))-1 ) = PACK(InData%upwind_align_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_align_angle) + DO i1 = LBOUND(InData%upwind_align_angle,1), UBOUND(InData%upwind_align_angle,1) + ReKiBuf(Re_Xferred) = InData%upwind_align_angle(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_align_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1777,8 +1764,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_align_angle,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_align_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_align_angle))-1 ) = PACK(InData%downwind_align_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_align_angle) + DO i1 = LBOUND(InData%downwind_align_angle,1), UBOUND(InData%downwind_align_angle,1) + ReKiBuf(Re_Xferred) = InData%downwind_align_angle(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1790,8 +1779,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_Xcoor))-1 ) = PACK(InData%upwind_turbine_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_Xcoor) + DO i1 = LBOUND(InData%upwind_turbine_Xcoor,1), UBOUND(InData%upwind_turbine_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1803,8 +1794,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_Ycoor))-1 ) = PACK(InData%upwind_turbine_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_Ycoor) + DO i1 = LBOUND(InData%upwind_turbine_Ycoor,1), UBOUND(InData%upwind_turbine_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%wind_farm_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1816,8 +1809,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wind_farm_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wind_farm_Xcoor))-1 ) = PACK(InData%wind_farm_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wind_farm_Xcoor) + DO i1 = LBOUND(InData%wind_farm_Xcoor,1), UBOUND(InData%wind_farm_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%wind_farm_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%wind_farm_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,8 +1824,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wind_farm_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wind_farm_Ycoor))-1 ) = PACK(InData%wind_farm_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wind_farm_Ycoor) + DO i1 = LBOUND(InData%wind_farm_Ycoor,1), UBOUND(InData%wind_farm_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%wind_farm_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1842,8 +1839,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_Xcoor))-1 ) = PACK(InData%downwind_turbine_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_Xcoor) + DO i1 = LBOUND(InData%downwind_turbine_Xcoor,1), UBOUND(InData%downwind_turbine_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1855,8 +1854,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_Ycoor))-1 ) = PACK(InData%downwind_turbine_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_Ycoor) + DO i1 = LBOUND(InData%downwind_turbine_Ycoor,1), UBOUND(InData%downwind_turbine_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE DWM_Packread_turbine_position_data @@ -1873,12 +1874,6 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1894,8 +1889,8 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SimulationOrder_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SimulationOrder_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine_sort_order not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1909,18 +1904,13 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Turbine_sort_order)>0) OutData%Turbine_sort_order = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Turbine_sort_order))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Turbine_sort_order) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Turbine_sort_order,1), UBOUND(OutData%Turbine_sort_order,1) + OutData%Turbine_sort_order(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%WT_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%WT_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineInfluenceData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1937,15 +1927,12 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TurbineInfluenceData)>0) OutData%TurbineInfluenceData = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TurbineInfluenceData))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TurbineInfluenceData) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TurbineInfluenceData,2), UBOUND(OutData%TurbineInfluenceData,2) + DO i1 = LBOUND(OutData%TurbineInfluenceData,1), UBOUND(OutData%TurbineInfluenceData,1) + OutData%TurbineInfluenceData(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_index not allocated Int_Xferred = Int_Xferred + 1 @@ -1960,15 +1947,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_index)>0) OutData%upwind_turbine_index = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%upwind_turbine_index))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%upwind_turbine_index) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_index,1), UBOUND(OutData%upwind_turbine_index,1) + OutData%upwind_turbine_index(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_index not allocated Int_Xferred = Int_Xferred + 1 @@ -1983,20 +1965,15 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_index)>0) OutData%downwind_turbine_index = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%downwind_turbine_index))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%downwind_turbine_index) - DEALLOCATE(mask1) - END IF - OutData%upwindturbine_number = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%downwindturbine_number = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%downwind_turbine_index,1), UBOUND(OutData%downwind_turbine_index,1) + OutData%downwind_turbine_index(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%upwindturbine_number = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%downwindturbine_number = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_windorigin_length not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2010,15 +1987,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%turbine_windorigin_length)>0) OutData%turbine_windorigin_length = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_windorigin_length))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_windorigin_length) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%turbine_windorigin_length,1), UBOUND(OutData%turbine_windorigin_length,1) + OutData%turbine_windorigin_length(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_projected_distance not allocated Int_Xferred = Int_Xferred + 1 @@ -2033,15 +2005,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_projected_distance)>0) OutData%upwind_turbine_projected_distance = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_projected_distance))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_projected_distance) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_projected_distance,1), UBOUND(OutData%upwind_turbine_projected_distance,1) + OutData%upwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_projected_distance not allocated Int_Xferred = Int_Xferred + 1 @@ -2056,15 +2023,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_projected_distance)>0) OutData%downwind_turbine_projected_distance = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_projected_distance))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_projected_distance) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_projected_distance,1), UBOUND(OutData%downwind_turbine_projected_distance,1) + OutData%downwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2082,15 +2044,12 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%turbine_angle)>0) OutData%turbine_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_angle))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_angle) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%turbine_angle,2), UBOUND(OutData%turbine_angle,2) + DO i1 = LBOUND(OutData%turbine_angle,1), UBOUND(OutData%turbine_angle,1) + OutData%turbine_angle(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_align_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2105,15 +2064,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_align_angle)>0) OutData%upwind_align_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_align_angle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_align_angle) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_align_angle,1), UBOUND(OutData%upwind_align_angle,1) + OutData%upwind_align_angle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_align_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2128,15 +2082,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_align_angle)>0) OutData%downwind_align_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_align_angle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_align_angle) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_align_angle,1), UBOUND(OutData%downwind_align_angle,1) + OutData%downwind_align_angle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2151,15 +2100,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_Xcoor)>0) OutData%upwind_turbine_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_Xcoor,1), UBOUND(OutData%upwind_turbine_Xcoor,1) + OutData%upwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2174,15 +2118,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_Ycoor)>0) OutData%upwind_turbine_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_Ycoor,1), UBOUND(OutData%upwind_turbine_Ycoor,1) + OutData%upwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2197,15 +2136,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wind_farm_Xcoor)>0) OutData%wind_farm_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wind_farm_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wind_farm_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wind_farm_Xcoor,1), UBOUND(OutData%wind_farm_Xcoor,1) + OutData%wind_farm_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2220,15 +2154,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wind_farm_Ycoor)>0) OutData%wind_farm_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wind_farm_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wind_farm_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wind_farm_Ycoor,1), UBOUND(OutData%wind_farm_Ycoor,1) + OutData%wind_farm_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2243,15 +2172,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_Xcoor)>0) OutData%downwind_turbine_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_Xcoor,1), UBOUND(OutData%downwind_turbine_Xcoor,1) + OutData%downwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2266,15 +2190,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_Ycoor)>0) OutData%downwind_turbine_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_Ycoor,1), UBOUND(OutData%downwind_turbine_Ycoor,1) + OutData%downwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE DWM_UnPackread_turbine_position_data @@ -2400,11 +2319,13 @@ SUBROUTINE DWM_PackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sweptarea,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sweptarea)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sweptarea))-1 ) = PACK(InData%sweptarea,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sweptarea) + DO i1 = LBOUND(InData%sweptarea,1), UBOUND(InData%sweptarea,1) + ReKiBuf(Re_Xferred) = InData%sweptarea(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%weighting_denominator - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%weighting_denominator + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackWeiMethod SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2420,12 +2341,6 @@ SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2453,18 +2368,13 @@ SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%sweptarea)>0) OutData%sweptarea = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sweptarea))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sweptarea) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%sweptarea,1), UBOUND(OutData%sweptarea,1) + OutData%sweptarea(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%weighting_denominator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%weighting_denominator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackWeiMethod SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) @@ -2651,67 +2561,71 @@ SUBROUTINE DWM_PackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI_downstream_matrix)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI_downstream_matrix))-1 ) = PACK(InData%TI_downstream_matrix,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI_downstream_matrix) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%j - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%k - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%cross_plane_position_ds - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%cross_plane_position_TI - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%distance_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%initial_timestep - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_downstream_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_node_temp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_apprant_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_average - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_apprant - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%wake_center_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%wake_center_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%zero_spacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp3 - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%TI_downstream_matrix,2), UBOUND(InData%TI_downstream_matrix,2) + DO i1 = LBOUND(InData%TI_downstream_matrix,1), UBOUND(InData%TI_downstream_matrix,1) + ReKiBuf(Re_Xferred) = InData%TI_downstream_matrix(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%j + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%k + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%cross_plane_position_ds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%cross_plane_position_TI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%distance_index + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%initial_timestep + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y_axis_turbine + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z_axis_turbine + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%distance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_downstream_node + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_node_temp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_node + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_accumulation + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_apprant_accumulation + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_average + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_apprant + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wake_center_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wake_center_z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rscale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%zero_spacing + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp3 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackTIDownstream SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2727,12 +2641,6 @@ SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2764,74 +2672,71 @@ SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI_downstream_matrix)>0) OutData%TI_downstream_matrix = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI_downstream_matrix))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI_downstream_matrix) - DEALLOCATE(mask2) - END IF - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_ds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_TI = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%counter1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%counter2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%initial_timestep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%y_axis_turbine = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z_axis_turbine = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%distance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream_node = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node_temp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_accumulation = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant_accumulation = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_average = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rscale = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%zero_spacing = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%TI_downstream_matrix,2), UBOUND(OutData%TI_downstream_matrix,2) + DO i1 = LBOUND(OutData%TI_downstream_matrix,1), UBOUND(OutData%TI_downstream_matrix,1) + OutData%TI_downstream_matrix(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%j = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%cross_plane_position_ds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%cross_plane_position_TI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%counter1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%counter2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%initial_timestep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%y_axis_turbine = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z_axis_turbine = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%distance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_downstream_node = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_node_temp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_node = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_accumulation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_apprant_accumulation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_average = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_apprant = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wake_center_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wake_center_z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rscale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%zero_spacing = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackTIDownstream SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) @@ -2937,20 +2842,20 @@ SUBROUTINE DWM_PackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%fs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%temp_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%low_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%high_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%lk_facor - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%STD - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%fs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%temp_n + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%low_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%high_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%lk_facor + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%STD + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackTurbKaimal SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2966,12 +2871,6 @@ SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackTurbKaimal' @@ -2985,20 +2884,20 @@ SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%fs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%temp_n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%low_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%high_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%lk_facor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%STD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%fs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%temp_n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%low_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%high_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%lk_facor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%STD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackTurbKaimal SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) @@ -3217,8 +3116,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%f_syn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%f_syn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%f_syn))-1 ) = PACK(InData%f_syn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%f_syn) + DO i1 = LBOUND(InData%f_syn,1), UBOUND(InData%f_syn,1) + ReKiBuf(Re_Xferred) = InData%f_syn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%t_syn) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3230,8 +3131,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_syn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t_syn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%t_syn))-1 ) = PACK(InData%t_syn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%t_syn) + DO i1 = LBOUND(InData%t_syn,1), UBOUND(InData%t_syn,1) + ReKiBuf(Re_Xferred) = InData%t_syn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%phi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3243,8 +3146,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%p_k) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3256,8 +3161,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_k,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%p_k)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%p_k))-1 ) = PACK(InData%p_k,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%p_k) + DO i1 = LBOUND(InData%p_k,1), UBOUND(InData%p_k,1) + ReKiBuf(Re_Xferred) = InData%p_k(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%a_k) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3269,25 +3176,27 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_k,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%a_k)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%a_k))-1 ) = PACK(InData%a_k,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%a_k) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%num_points - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ILo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%j - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t_min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t_max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%df - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%a_k,1), UBOUND(InData%a_k,1) + ReKiBuf(Re_Xferred) = InData%a_k(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%num_points + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ILo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%j + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t_min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t_max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%df + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackShinozuka SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3303,12 +3212,6 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3336,15 +3239,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%f_syn)>0) OutData%f_syn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%f_syn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%f_syn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f_syn,1), UBOUND(OutData%f_syn,1) + OutData%f_syn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_syn not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3257,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%t_syn)>0) OutData%t_syn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%t_syn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%t_syn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%t_syn,1), UBOUND(OutData%t_syn,1) + OutData%t_syn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated Int_Xferred = Int_Xferred + 1 @@ -3382,15 +3275,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_k not allocated Int_Xferred = Int_Xferred + 1 @@ -3405,15 +3293,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%p_k)>0) OutData%p_k = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%p_k))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%p_k) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p_k,1), UBOUND(OutData%p_k,1) + OutData%p_k(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_k not allocated Int_Xferred = Int_Xferred + 1 @@ -3428,32 +3311,27 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%a_k)>0) OutData%a_k = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%a_k))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%a_k) - DEALLOCATE(mask1) - END IF - OutData%num_points = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ILo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t_min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t_max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%df = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%a_k,1), UBOUND(OutData%a_k,1) + OutData%a_k(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%num_points = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ILo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%j = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t_min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t_max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%df = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackShinozuka SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -3547,8 +3425,8 @@ SUBROUTINE DWM_Packsmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%length_velocity_array - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%length_velocity_array + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packsmooth_out_wake_data SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3564,12 +3442,6 @@ SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' @@ -3583,8 +3455,8 @@ SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%length_velocity_array = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%length_velocity_array = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPacksmooth_out_wake_data SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) @@ -3688,18 +3560,18 @@ SUBROUTINE DWM_PackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%unit - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%distance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%unit + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackSWSV SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3715,12 +3587,6 @@ SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackSWSV' @@ -3734,18 +3600,18 @@ SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%p1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%p2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%y0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%unit = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%p1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%p2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%y0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%unit = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackSWSV SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) @@ -4090,8 +3956,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_U)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_U))-1 ) = PACK(InData%upwind_U,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_U) + DO i2 = LBOUND(InData%upwind_U,2), UBOUND(InData%upwind_U,2) + DO i1 = LBOUND(InData%upwind_U,1), UBOUND(InData%upwind_U,1) + ReKiBuf(Re_Xferred) = InData%upwind_U(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_wakecenter) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4112,8 +3982,16 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_wakecenter)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_wakecenter))-1 ) = PACK(InData%upwind_wakecenter,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_wakecenter) + DO i4 = LBOUND(InData%upwind_wakecenter,4), UBOUND(InData%upwind_wakecenter,4) + DO i3 = LBOUND(InData%upwind_wakecenter,3), UBOUND(InData%upwind_wakecenter,3) + DO i2 = LBOUND(InData%upwind_wakecenter,2), UBOUND(InData%upwind_wakecenter,2) + DO i1 = LBOUND(InData%upwind_wakecenter,1), UBOUND(InData%upwind_wakecenter,1) + ReKiBuf(Re_Xferred) = InData%upwind_wakecenter(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_meanU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4125,8 +4003,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_meanU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_meanU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_meanU))-1 ) = PACK(InData%upwind_meanU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_meanU) + DO i1 = LBOUND(InData%upwind_meanU,1), UBOUND(InData%upwind_meanU,1) + ReKiBuf(Re_Xferred) = InData%upwind_meanU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4138,8 +4018,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_TI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_TI))-1 ) = PACK(InData%upwind_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_TI) + DO i1 = LBOUND(InData%upwind_TI,1), UBOUND(InData%upwind_TI,1) + ReKiBuf(Re_Xferred) = InData%upwind_TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_small_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4151,8 +4033,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_small_TI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_small_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_small_TI))-1 ) = PACK(InData%upwind_small_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_small_TI) + DO i1 = LBOUND(InData%upwind_small_TI,1), UBOUND(InData%upwind_small_TI,1) + ReKiBuf(Re_Xferred) = InData%upwind_small_TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_smoothWake) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4167,8 +4051,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_smoothWake)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_smoothWake))-1 ) = PACK(InData%upwind_smoothWake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_smoothWake) + DO i2 = LBOUND(InData%upwind_smoothWake,2), UBOUND(InData%upwind_smoothWake,2) + DO i1 = LBOUND(InData%upwind_smoothWake,1), UBOUND(InData%upwind_smoothWake,1) + ReKiBuf(Re_Xferred) = InData%upwind_smoothWake(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%velocity_aerodyn) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4180,8 +4068,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocity_aerodyn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%velocity_aerodyn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%velocity_aerodyn))-1 ) = PACK(InData%velocity_aerodyn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%velocity_aerodyn) + DO i1 = LBOUND(InData%velocity_aerodyn,1), UBOUND(InData%velocity_aerodyn,1) + ReKiBuf(Re_Xferred) = InData%velocity_aerodyn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TI_downstream) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4193,8 +4083,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI_downstream)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI_downstream))-1 ) = PACK(InData%TI_downstream,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI_downstream) + DO i1 = LBOUND(InData%TI_downstream,1), UBOUND(InData%TI_downstream,1) + ReKiBuf(Re_Xferred) = InData%TI_downstream(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%small_scale_TI_downstream) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4206,8 +4098,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%small_scale_TI_downstream,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%small_scale_TI_downstream)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%small_scale_TI_downstream))-1 ) = PACK(InData%small_scale_TI_downstream,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%small_scale_TI_downstream) + DO i1 = LBOUND(InData%small_scale_TI_downstream,1), UBOUND(InData%small_scale_TI_downstream,1) + ReKiBuf(Re_Xferred) = InData%small_scale_TI_downstream(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4222,8 +4116,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_velocity_array))-1 ) = PACK(InData%smoothed_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_velocity_array) + DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) + DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vel_matrix) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4241,8 +4139,14 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vel_matrix)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vel_matrix))-1 ) = PACK(InData%vel_matrix,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vel_matrix) + DO i3 = LBOUND(InData%vel_matrix,3), UBOUND(InData%vel_matrix,3) + DO i2 = LBOUND(InData%vel_matrix,2), UBOUND(InData%vel_matrix,2) + DO i1 = LBOUND(InData%vel_matrix,1), UBOUND(InData%vel_matrix,1) + ReKiBuf(Re_Xferred) = InData%vel_matrix(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DWM_Packread_upwind_result @@ -4259,12 +4163,6 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4298,15 +4196,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%upwind_U)>0) OutData%upwind_U = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_U))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_U) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%upwind_U,2), UBOUND(OutData%upwind_U,2) + DO i1 = LBOUND(OutData%upwind_U,1), UBOUND(OutData%upwind_U,1) + OutData%upwind_U(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_wakecenter not allocated Int_Xferred = Int_Xferred + 1 @@ -4330,15 +4225,16 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%upwind_wakecenter)>0) OutData%upwind_wakecenter = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_wakecenter))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_wakecenter) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%upwind_wakecenter,4), UBOUND(OutData%upwind_wakecenter,4) + DO i3 = LBOUND(OutData%upwind_wakecenter,3), UBOUND(OutData%upwind_wakecenter,3) + DO i2 = LBOUND(OutData%upwind_wakecenter,2), UBOUND(OutData%upwind_wakecenter,2) + DO i1 = LBOUND(OutData%upwind_wakecenter,1), UBOUND(OutData%upwind_wakecenter,1) + OutData%upwind_wakecenter(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_meanU not allocated Int_Xferred = Int_Xferred + 1 @@ -4353,15 +4249,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_meanU)>0) OutData%upwind_meanU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_meanU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_meanU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_meanU,1), UBOUND(OutData%upwind_meanU,1) + OutData%upwind_meanU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -4376,15 +4267,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_TI)>0) OutData%upwind_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_TI,1), UBOUND(OutData%upwind_TI,1) + OutData%upwind_TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_small_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -4399,15 +4285,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_small_TI)>0) OutData%upwind_small_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_small_TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_small_TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_small_TI,1), UBOUND(OutData%upwind_small_TI,1) + OutData%upwind_small_TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_smoothWake not allocated Int_Xferred = Int_Xferred + 1 @@ -4425,15 +4306,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%upwind_smoothWake)>0) OutData%upwind_smoothWake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_smoothWake))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_smoothWake) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%upwind_smoothWake,2), UBOUND(OutData%upwind_smoothWake,2) + DO i1 = LBOUND(OutData%upwind_smoothWake,1), UBOUND(OutData%upwind_smoothWake,1) + OutData%upwind_smoothWake(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocity_aerodyn not allocated Int_Xferred = Int_Xferred + 1 @@ -4448,15 +4326,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%velocity_aerodyn)>0) OutData%velocity_aerodyn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%velocity_aerodyn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%velocity_aerodyn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%velocity_aerodyn,1), UBOUND(OutData%velocity_aerodyn,1) + OutData%velocity_aerodyn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream not allocated Int_Xferred = Int_Xferred + 1 @@ -4471,15 +4344,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TI_downstream)>0) OutData%TI_downstream = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI_downstream))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI_downstream) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TI_downstream,1), UBOUND(OutData%TI_downstream,1) + OutData%TI_downstream(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! small_scale_TI_downstream not allocated Int_Xferred = Int_Xferred + 1 @@ -4494,15 +4362,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%small_scale_TI_downstream)>0) OutData%small_scale_TI_downstream = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%small_scale_TI_downstream))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%small_scale_TI_downstream) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%small_scale_TI_downstream,1), UBOUND(OutData%small_scale_TI_downstream,1) + OutData%small_scale_TI_downstream(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -4520,15 +4383,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%smoothed_velocity_array)>0) OutData%smoothed_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_velocity_array))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_velocity_array) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) + DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) + OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vel_matrix not allocated Int_Xferred = Int_Xferred + 1 @@ -4549,15 +4409,14 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vel_matrix)>0) OutData%vel_matrix = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vel_matrix))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vel_matrix) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vel_matrix,3), UBOUND(OutData%vel_matrix,3) + DO i2 = LBOUND(OutData%vel_matrix,2), UBOUND(OutData%vel_matrix,2) + DO i1 = LBOUND(OutData%vel_matrix,1), UBOUND(OutData%vel_matrix,1) + OutData%vel_matrix(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DWM_UnPackread_upwind_result @@ -4681,8 +4540,10 @@ SUBROUTINE DWM_Packwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_width,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_width)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%wake_width))-1 ) = PACK(InData%wake_width,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%wake_width) + DO i1 = LBOUND(InData%wake_width,1), UBOUND(InData%wake_width,1) + IntKiBuf(Int_Xferred) = InData%wake_width(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE DWM_Packwake_meandered_center @@ -4699,12 +4560,6 @@ SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4732,15 +4587,10 @@ SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wake_width)>0) OutData%wake_width = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%wake_width))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%wake_width) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wake_width,1), UBOUND(OutData%wake_width,1) + OutData%wake_width(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE DWM_UnPackwake_meandered_center @@ -4839,12 +4689,12 @@ SUBROUTINE DWM_Packturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Aerodyn_turbine_num - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Blade_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Element_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Aerodyn_turbine_num + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Blade_index + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Element_index + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packturbine_blade SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4860,12 +4710,6 @@ SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackturbine_blade' @@ -4879,12 +4723,12 @@ SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Aerodyn_turbine_num = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Blade_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Element_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Aerodyn_turbine_num = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Blade_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Element_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackturbine_blade SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -5158,8 +5002,10 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocityU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%velocityU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%velocityU))-1 ) = PACK(InData%velocityU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%velocityU) + DO i1 = LBOUND(InData%velocityU,1), UBOUND(InData%velocityU,1) + ReKiBuf(Re_Xferred) = InData%velocityU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_wake) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5171,8 +5017,10 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_wake,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_wake)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_wake))-1 ) = PACK(InData%smoothed_wake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_wake) + DO i1 = LBOUND(InData%smoothed_wake,1), UBOUND(InData%smoothed_wake,1) + ReKiBuf(Re_Xferred) = InData%smoothed_wake(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WakePosition) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5190,47 +5038,53 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WakePosition)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WakePosition))-1 ) = PACK(InData%WakePosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WakePosition) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakePosition_1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakePosition_2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%smooth_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p_p_r - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Tinfluencer - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotorR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%r_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%x_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uambient - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_wake - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hub_height - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%length_velocityU - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WFLowerBd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Wind_file_Mean_u - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Winddir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%air_density - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RR - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%WakePosition,3), UBOUND(InData%WakePosition,3) + DO i2 = LBOUND(InData%WakePosition,2), UBOUND(InData%WakePosition,2) + DO i1 = LBOUND(InData%WakePosition,1), UBOUND(InData%WakePosition,1) + ReKiBuf(Re_Xferred) = InData%WakePosition(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%WakePosition_1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakePosition_2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%smooth_flag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p_p_r + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Tinfluencer + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotorR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%r_domain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%x_domain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Uambient + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_amb + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_wake + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hub_height + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%length_velocityU + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WFLowerBd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Wind_file_Mean_u + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Winddir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%air_density + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RR + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ElementRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5241,13 +5095,15 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElementRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElementRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ElementRad))-1 ) = PACK(InData%ElementRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ElementRad) + DO i1 = LBOUND(InData%ElementRad,1), UBOUND(InData%ElementRad,1) + ReKiBuf(Re_Xferred) = InData%ElementRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Bnum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ElementNum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Bnum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ElementNum + Int_Xferred = Int_Xferred + 1 CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, OnlySize ) ! RTPD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5319,12 +5175,6 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5354,15 +5204,10 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%velocityU)>0) OutData%velocityU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%velocityU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%velocityU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%velocityU,1), UBOUND(OutData%velocityU,1) + OutData%velocityU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_wake not allocated Int_Xferred = Int_Xferred + 1 @@ -5377,15 +5222,10 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%smoothed_wake)>0) OutData%smoothed_wake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_wake))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_wake) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%smoothed_wake,1), UBOUND(OutData%smoothed_wake,1) + OutData%smoothed_wake(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakePosition not allocated Int_Xferred = Int_Xferred + 1 @@ -5406,54 +5246,53 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WakePosition)>0) OutData%WakePosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WakePosition))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WakePosition) - DEALLOCATE(mask3) - END IF - OutData%WakePosition_1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WakePosition_2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%smooth_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%p_p_r = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumWT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tinfluencer = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RotorR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%r_domain = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%x_domain = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Uambient = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_wake = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hub_height = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%length_velocityU = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WFLowerBd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Wind_file_Mean_u = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Winddir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%air_density = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%WakePosition,3), UBOUND(OutData%WakePosition,3) + DO i2 = LBOUND(OutData%WakePosition,2), UBOUND(OutData%WakePosition,2) + DO i1 = LBOUND(OutData%WakePosition,1), UBOUND(OutData%WakePosition,1) + OutData%WakePosition(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%WakePosition_1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakePosition_2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%smooth_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%p_p_r = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumWT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tinfluencer = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotorR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%r_domain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%x_domain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Uambient = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_amb = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_wake = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hub_height = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%length_velocityU = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WFLowerBd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Wind_file_Mean_u = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Winddir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%air_density = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElementRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5467,20 +5306,15 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElementRad)>0) OutData%ElementRad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ElementRad))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ElementRad) - DEALLOCATE(mask1) - END IF - OutData%Bnum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ElementNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ElementRad,1), UBOUND(OutData%ElementRad,1) + OutData%ElementRad(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Bnum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElementNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5717,12 +5551,6 @@ SUBROUTINE DWM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackOtherState' @@ -6235,18 +6063,18 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%position_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%position_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%velocity_wake_mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%shifted_velocity_Aerodyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%U_velocity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V_velocity - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%position_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%position_z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%velocity_wake_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%shifted_velocity_Aerodyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%U_velocity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%V_velocity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nforce) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6260,8 +6088,12 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nforce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Nforce))-1 ) = PACK(InData%Nforce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Nforce) + DO i2 = LBOUND(InData%Nforce,2), UBOUND(InData%Nforce,2) + DO i1 = LBOUND(InData%Nforce,1), UBOUND(InData%Nforce,1) + ReKiBuf(Re_Xferred) = InData%Nforce(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%blade_dr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6273,13 +6105,15 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%blade_dr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%blade_dr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%blade_dr))-1 ) = PACK(InData%blade_dr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%blade_dr) + DO i1 = LBOUND(InData%blade_dr,1), UBOUND(InData%blade_dr,1) + ReKiBuf(Re_Xferred) = InData%blade_dr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_original - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_original + Re_Xferred = Re_Xferred + 1 CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, OnlySize ) ! TAVD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6560,12 +6394,12 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ct_tilde - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FAST_Time - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SDtimestep - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ct_tilde + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FAST_Time + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SDtimestep + Int_Xferred = Int_Xferred + 1 CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, OnlySize ) ! DWM_tb CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6637,12 +6471,6 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6698,18 +6526,18 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%position_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%position_z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%velocity_wake_mean = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%shifted_velocity_Aerodyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%U_velocity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%V_velocity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%position_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%position_z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%velocity_wake_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%shifted_velocity_Aerodyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%U_velocity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%V_velocity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nforce not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6726,15 +6554,12 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Nforce)>0) OutData%Nforce = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Nforce))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Nforce) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Nforce,2), UBOUND(OutData%Nforce,2) + DO i1 = LBOUND(OutData%Nforce,1), UBOUND(OutData%Nforce,1) + OutData%Nforce(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! blade_dr not allocated Int_Xferred = Int_Xferred + 1 @@ -6749,20 +6574,15 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%blade_dr)>0) OutData%blade_dr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%blade_dr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%blade_dr) - DEALLOCATE(mask1) - END IF - OutData%NacYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_original = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%blade_dr,1), UBOUND(OutData%blade_dr,1) + OutData%blade_dr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_original = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7163,12 +6983,12 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ct_tilde = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FAST_Time = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SDtimestep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%ct_tilde = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FAST_Time = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SDtimestep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7454,12 +7274,6 @@ SUBROUTINE DWM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInput' @@ -7863,8 +7677,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_thrust_force,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_thrust_force)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_thrust_force))-1 ) = PACK(InData%turbine_thrust_force,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_thrust_force) + DO i1 = LBOUND(InData%turbine_thrust_force,1), UBOUND(InData%turbine_thrust_force,1) + ReKiBuf(Re_Xferred) = InData%turbine_thrust_force(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%induction_factor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7876,8 +7692,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%induction_factor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%induction_factor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%induction_factor))-1 ) = PACK(InData%induction_factor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%induction_factor) + DO i1 = LBOUND(InData%induction_factor,1), UBOUND(InData%induction_factor,1) + ReKiBuf(Re_Xferred) = InData%induction_factor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%r_initial) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7889,8 +7707,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_initial,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%r_initial)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_initial))-1 ) = PACK(InData%r_initial,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_initial) + DO i1 = LBOUND(InData%r_initial,1), UBOUND(InData%r_initial,1) + ReKiBuf(Re_Xferred) = InData%r_initial(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%U_initial) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7902,8 +7722,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_initial,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%U_initial)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U_initial))-1 ) = PACK(InData%U_initial,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U_initial) + DO i1 = LBOUND(InData%U_initial,1), UBOUND(InData%U_initial,1) + ReKiBuf(Re_Xferred) = InData%U_initial(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Mean_FFWS_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7915,15 +7737,17 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mean_FFWS_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mean_FFWS_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mean_FFWS_array))-1 ) = PACK(InData%Mean_FFWS_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mean_FFWS_array) + DO i1 = LBOUND(InData%Mean_FFWS_array,1), UBOUND(InData%Mean_FFWS_array,1) + ReKiBuf(Re_Xferred) = InData%Mean_FFWS_array(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Mean_FFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_downstream - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Mean_FFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_downstream + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%wake_u) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7937,8 +7761,12 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wake_u))-1 ) = PACK(InData%wake_u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wake_u) + DO i2 = LBOUND(InData%wake_u,2), UBOUND(InData%wake_u,2) + DO i1 = LBOUND(InData%wake_u,1), UBOUND(InData%wake_u,1) + ReKiBuf(Re_Xferred) = InData%wake_u(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%wake_position) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7956,8 +7784,14 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_position)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wake_position))-1 ) = PACK(InData%wake_position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wake_position) + DO i3 = LBOUND(InData%wake_position,3), UBOUND(InData%wake_position,3) + DO i2 = LBOUND(InData%wake_position,2), UBOUND(InData%wake_position,2) + DO i1 = LBOUND(InData%wake_position,1), UBOUND(InData%wake_position,1) + ReKiBuf(Re_Xferred) = InData%wake_position(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7972,19 +7806,23 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_velocity_array))-1 ) = PACK(InData%smoothed_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_velocity_array) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AtmUscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%du_dz_ABL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%total_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mean_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%avg_ct - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) + DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AtmUscale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%du_dz_ABL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%total_SDgenpwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mean_SDgenpwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%avg_ct + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8028,12 +7866,6 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -8063,15 +7895,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%turbine_thrust_force)>0) OutData%turbine_thrust_force = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_thrust_force))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_thrust_force) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%turbine_thrust_force,1), UBOUND(OutData%turbine_thrust_force,1) + OutData%turbine_thrust_force(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! induction_factor not allocated Int_Xferred = Int_Xferred + 1 @@ -8086,15 +7913,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%induction_factor)>0) OutData%induction_factor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%induction_factor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%induction_factor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%induction_factor,1), UBOUND(OutData%induction_factor,1) + OutData%induction_factor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_initial not allocated Int_Xferred = Int_Xferred + 1 @@ -8109,15 +7931,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%r_initial)>0) OutData%r_initial = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_initial))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_initial) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_initial,1), UBOUND(OutData%r_initial,1) + OutData%r_initial(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_initial not allocated Int_Xferred = Int_Xferred + 1 @@ -8132,15 +7949,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%U_initial)>0) OutData%U_initial = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U_initial))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U_initial) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%U_initial,1), UBOUND(OutData%U_initial,1) + OutData%U_initial(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mean_FFWS_array not allocated Int_Xferred = Int_Xferred + 1 @@ -8155,22 +7967,17 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Mean_FFWS_array)>0) OutData%Mean_FFWS_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mean_FFWS_array))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mean_FFWS_array) - DEALLOCATE(mask1) - END IF - OutData%Mean_FFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%Mean_FFWS_array,1), UBOUND(OutData%Mean_FFWS_array,1) + OutData%Mean_FFWS_array(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Mean_FFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_downstream = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_u not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8187,15 +7994,12 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%wake_u)>0) OutData%wake_u = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wake_u))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wake_u) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%wake_u,2), UBOUND(OutData%wake_u,2) + DO i1 = LBOUND(OutData%wake_u,1), UBOUND(OutData%wake_u,1) + OutData%wake_u(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_position not allocated Int_Xferred = Int_Xferred + 1 @@ -8216,15 +8020,14 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%wake_position)>0) OutData%wake_position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wake_position))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wake_position) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%wake_position,3), UBOUND(OutData%wake_position,3) + DO i2 = LBOUND(OutData%wake_position,2), UBOUND(OutData%wake_position,2) + DO i1 = LBOUND(OutData%wake_position,1), UBOUND(OutData%wake_position,1) + OutData%wake_position(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -8242,26 +8045,23 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%smoothed_velocity_array)>0) OutData%smoothed_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_velocity_array))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_velocity_array) - DEALLOCATE(mask2) - END IF - OutData%AtmUscale = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%du_dz_ABL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%total_SDgenpwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mean_SDgenpwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%avg_ct = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) + DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) + OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%AtmUscale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%du_dz_ABL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%total_SDgenpwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mean_SDgenpwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%avg_ct = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8417,8 +8217,8 @@ SUBROUTINE DWM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8462,12 +8262,6 @@ SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackContState' @@ -8481,8 +8275,8 @@ SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8638,8 +8432,8 @@ SUBROUTINE DWM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8683,12 +8477,6 @@ SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackDiscState' @@ -8702,8 +8490,8 @@ SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8859,8 +8647,8 @@ SUBROUTINE DWM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8904,12 +8692,6 @@ SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackConstrState' @@ -8923,8 +8705,8 @@ SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9080,8 +8862,8 @@ SUBROUTINE DWM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9125,12 +8907,6 @@ SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitInput' @@ -9144,8 +8920,8 @@ SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9301,8 +9077,8 @@ SUBROUTINE DWM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9346,12 +9122,6 @@ SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitOutput' @@ -9365,8 +9135,8 @@ SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9484,18 +9254,18 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9508,97 +9278,89 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - b2 = -(u1%Upwind_result%upwind_U - u2%Upwind_result%upwind_U)/t(2) - u_out%Upwind_result%upwind_U = u1%Upwind_result%upwind_U + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) + b = -(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - ALLOCATE(b4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - ALLOCATE(c4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - b4 = -(u1%Upwind_result%upwind_wakecenter - u2%Upwind_result%upwind_wakecenter)/t(2) - u_out%Upwind_result%upwind_wakecenter = u1%Upwind_result%upwind_wakecenter + b4 * t_out - DEALLOCATE(b4) - DEALLOCATE(c4) + DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) + DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) + DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) + b = -(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b * ScaleFactor + END DO + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - b1 = -(u1%Upwind_result%upwind_meanU - u2%Upwind_result%upwind_meanU)/t(2) - u_out%Upwind_result%upwind_meanU = u1%Upwind_result%upwind_meanU + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) + b = -(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_TI,1))) - b1 = -(u1%Upwind_result%upwind_TI - u2%Upwind_result%upwind_TI)/t(2) - u_out%Upwind_result%upwind_TI = u1%Upwind_result%upwind_TI + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) + b = -(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - b1 = -(u1%Upwind_result%upwind_small_TI - u2%Upwind_result%upwind_small_TI)/t(2) - u_out%Upwind_result%upwind_small_TI = u1%Upwind_result%upwind_small_TI + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) + b = -(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - b2 = -(u1%Upwind_result%upwind_smoothWake - u2%Upwind_result%upwind_smoothWake)/t(2) - u_out%Upwind_result%upwind_smoothWake = u1%Upwind_result%upwind_smoothWake + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) + b = -(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - b1 = -(u1%Upwind_result%velocity_aerodyn - u2%Upwind_result%velocity_aerodyn)/t(2) - u_out%Upwind_result%velocity_aerodyn = u1%Upwind_result%velocity_aerodyn + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) + b = -(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%TI_downstream,1))) - b1 = -(u1%Upwind_result%TI_downstream - u2%Upwind_result%TI_downstream)/t(2) - u_out%Upwind_result%TI_downstream = u1%Upwind_result%TI_downstream + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) + b = -(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - b1 = -(u1%Upwind_result%small_scale_TI_downstream - u2%Upwind_result%small_scale_TI_downstream)/t(2) - u_out%Upwind_result%small_scale_TI_downstream = u1%Upwind_result%small_scale_TI_downstream + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) + b = -(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - b2 = -(u1%Upwind_result%smoothed_velocity_array - u2%Upwind_result%smoothed_velocity_array)/t(2) - u_out%Upwind_result%smoothed_velocity_array = u1%Upwind_result%smoothed_velocity_array + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) + DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) + b = -(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - ALLOCATE(b3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - ALLOCATE(c3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - b3 = -(u1%Upwind_result%vel_matrix - u2%Upwind_result%vel_matrix)/t(2) - u_out%Upwind_result%vel_matrix = u1%Upwind_result%vel_matrix + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) + DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) + DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) + b = -(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9631,19 +9393,20 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9662,108 +9425,100 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - b2 = (t(3)**2*(u1%Upwind_result%upwind_U - u2%Upwind_result%upwind_U) + t(2)**2*(-u1%Upwind_result%upwind_U + u3%Upwind_result%upwind_U))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%upwind_U + t(3)*u2%Upwind_result%upwind_U - t(2)*u3%Upwind_result%upwind_U ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_U = u1%Upwind_result%upwind_U + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) + b = (t(3)**2*(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_U(i1,i2) + u3%Upwind_result%upwind_U(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_U(i1,i2) + t(3)*u2%Upwind_result%upwind_U(i1,i2) - t(2)*u3%Upwind_result%upwind_U(i1,i2) ) * scaleFactor + u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - ALLOCATE(b4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - ALLOCATE(c4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - b4 = (t(3)**2*(u1%Upwind_result%upwind_wakecenter - u2%Upwind_result%upwind_wakecenter) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter + u3%Upwind_result%upwind_wakecenter))/(t(2)*t(3)*(t(2) - t(3))) - c4 = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter + t(3)*u2%Upwind_result%upwind_wakecenter - t(2)*u3%Upwind_result%upwind_wakecenter ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_wakecenter = u1%Upwind_result%upwind_wakecenter + b4 * t_out + c4 * t_out**2 - DEALLOCATE(b4) - DEALLOCATE(c4) + DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) + DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) + DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) + b = (t(3)**2*(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + t(3)*u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - t(2)*u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) ) * scaleFactor + u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b + c * t_out + END DO + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_meanU - u2%Upwind_result%upwind_meanU) + t(2)**2*(-u1%Upwind_result%upwind_meanU + u3%Upwind_result%upwind_meanU))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU + t(3)*u2%Upwind_result%upwind_meanU - t(2)*u3%Upwind_result%upwind_meanU ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_meanU = u1%Upwind_result%upwind_meanU + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) + b = (t(3)**2*(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + t(2)**2*(-u1%Upwind_result%upwind_meanU(i1) + u3%Upwind_result%upwind_meanU(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU(i1) + t(3)*u2%Upwind_result%upwind_meanU(i1) - t(2)*u3%Upwind_result%upwind_meanU(i1) ) * scaleFactor + u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_TI,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_TI - u2%Upwind_result%upwind_TI) + t(2)**2*(-u1%Upwind_result%upwind_TI + u3%Upwind_result%upwind_TI))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI + t(3)*u2%Upwind_result%upwind_TI - t(2)*u3%Upwind_result%upwind_TI ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_TI = u1%Upwind_result%upwind_TI + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) + b = (t(3)**2*(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_TI(i1) + u3%Upwind_result%upwind_TI(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI(i1) + t(3)*u2%Upwind_result%upwind_TI(i1) - t(2)*u3%Upwind_result%upwind_TI(i1) ) * scaleFactor + u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_small_TI - u2%Upwind_result%upwind_small_TI) + t(2)**2*(-u1%Upwind_result%upwind_small_TI + u3%Upwind_result%upwind_small_TI))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI + t(3)*u2%Upwind_result%upwind_small_TI - t(2)*u3%Upwind_result%upwind_small_TI ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_small_TI = u1%Upwind_result%upwind_small_TI + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) + b = (t(3)**2*(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_small_TI(i1) + u3%Upwind_result%upwind_small_TI(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI(i1) + t(3)*u2%Upwind_result%upwind_small_TI(i1) - t(2)*u3%Upwind_result%upwind_small_TI(i1) ) * scaleFactor + u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - b2 = (t(3)**2*(u1%Upwind_result%upwind_smoothWake - u2%Upwind_result%upwind_smoothWake) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake + u3%Upwind_result%upwind_smoothWake))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake + t(3)*u2%Upwind_result%upwind_smoothWake - t(2)*u3%Upwind_result%upwind_smoothWake ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_smoothWake = u1%Upwind_result%upwind_smoothWake + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) + b = (t(3)**2*(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake(i1,i2) + u3%Upwind_result%upwind_smoothWake(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake(i1,i2) + t(3)*u2%Upwind_result%upwind_smoothWake(i1,i2) - t(2)*u3%Upwind_result%upwind_smoothWake(i1,i2) ) * scaleFactor + u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - b1 = (t(3)**2*(u1%Upwind_result%velocity_aerodyn - u2%Upwind_result%velocity_aerodyn) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn + u3%Upwind_result%velocity_aerodyn))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn + t(3)*u2%Upwind_result%velocity_aerodyn - t(2)*u3%Upwind_result%velocity_aerodyn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%velocity_aerodyn = u1%Upwind_result%velocity_aerodyn + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) + b = (t(3)**2*(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn(i1) + u3%Upwind_result%velocity_aerodyn(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn(i1) + t(3)*u2%Upwind_result%velocity_aerodyn(i1) - t(2)*u3%Upwind_result%velocity_aerodyn(i1) ) * scaleFactor + u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%TI_downstream,1))) - b1 = (t(3)**2*(u1%Upwind_result%TI_downstream - u2%Upwind_result%TI_downstream) + t(2)**2*(-u1%Upwind_result%TI_downstream + u3%Upwind_result%TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream + t(3)*u2%Upwind_result%TI_downstream - t(2)*u3%Upwind_result%TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%TI_downstream = u1%Upwind_result%TI_downstream + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) + b = (t(3)**2*(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%TI_downstream(i1) + u3%Upwind_result%TI_downstream(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream(i1) + t(3)*u2%Upwind_result%TI_downstream(i1) - t(2)*u3%Upwind_result%TI_downstream(i1) ) * scaleFactor + u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - b1 = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream - u2%Upwind_result%small_scale_TI_downstream) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream + u3%Upwind_result%small_scale_TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream + t(3)*u2%Upwind_result%small_scale_TI_downstream - t(2)*u3%Upwind_result%small_scale_TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%small_scale_TI_downstream = u1%Upwind_result%small_scale_TI_downstream + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) + b = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream(i1) + u3%Upwind_result%small_scale_TI_downstream(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream(i1) + t(3)*u2%Upwind_result%small_scale_TI_downstream(i1) - t(2)*u3%Upwind_result%small_scale_TI_downstream(i1) ) * scaleFactor + u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - b2 = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array - u2%Upwind_result%smoothed_velocity_array) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array + u3%Upwind_result%smoothed_velocity_array))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array + t(3)*u2%Upwind_result%smoothed_velocity_array - t(2)*u3%Upwind_result%smoothed_velocity_array ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%smoothed_velocity_array = u1%Upwind_result%smoothed_velocity_array + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) + DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) + b = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array(i1,i2) + u3%Upwind_result%smoothed_velocity_array(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array(i1,i2) + t(3)*u2%Upwind_result%smoothed_velocity_array(i1,i2) - t(2)*u3%Upwind_result%smoothed_velocity_array(i1,i2) ) * scaleFactor + u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - ALLOCATE(b3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - ALLOCATE(c3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - b3 = (t(3)**2*(u1%Upwind_result%vel_matrix - u2%Upwind_result%vel_matrix) + t(2)**2*(-u1%Upwind_result%vel_matrix + u3%Upwind_result%vel_matrix))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix + t(3)*u2%Upwind_result%vel_matrix - t(2)*u3%Upwind_result%vel_matrix ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%vel_matrix = u1%Upwind_result%vel_matrix + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) + DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) + DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) + b = (t(3)**2*(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + t(2)**2*(-u1%Upwind_result%vel_matrix(i1,i2,i3) + u3%Upwind_result%vel_matrix(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix(i1,i2,i3) + t(3)*u2%Upwind_result%vel_matrix(i1,i2,i3) - t(2)*u3%Upwind_result%vel_matrix(i1,i2,i3) ) * scaleFactor + u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9844,16 +9599,16 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9866,88 +9621,80 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - ALLOCATE(b1(SIZE(y_out%turbine_thrust_force,1))) - ALLOCATE(c1(SIZE(y_out%turbine_thrust_force,1))) - b1 = -(y1%turbine_thrust_force - y2%turbine_thrust_force)/t(2) - y_out%turbine_thrust_force = y1%turbine_thrust_force + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) + b = -(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - ALLOCATE(b1(SIZE(y_out%induction_factor,1))) - ALLOCATE(c1(SIZE(y_out%induction_factor,1))) - b1 = -(y1%induction_factor - y2%induction_factor)/t(2) - y_out%induction_factor = y1%induction_factor + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) + b = -(y1%induction_factor(i1) - y2%induction_factor(i1)) + y_out%induction_factor(i1) = y1%induction_factor(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - ALLOCATE(b1(SIZE(y_out%r_initial,1))) - ALLOCATE(c1(SIZE(y_out%r_initial,1))) - b1 = -(y1%r_initial - y2%r_initial)/t(2) - y_out%r_initial = y1%r_initial + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) + b = -(y1%r_initial(i1) - y2%r_initial(i1)) + y_out%r_initial(i1) = y1%r_initial(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - ALLOCATE(b1(SIZE(y_out%U_initial,1))) - ALLOCATE(c1(SIZE(y_out%U_initial,1))) - b1 = -(y1%U_initial - y2%U_initial)/t(2) - y_out%U_initial = y1%U_initial + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) + b = -(y1%U_initial(i1) - y2%U_initial(i1)) + y_out%U_initial(i1) = y1%U_initial(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - ALLOCATE(b1(SIZE(y_out%Mean_FFWS_array,1))) - ALLOCATE(c1(SIZE(y_out%Mean_FFWS_array,1))) - b1 = -(y1%Mean_FFWS_array - y2%Mean_FFWS_array)/t(2) - y_out%Mean_FFWS_array = y1%Mean_FFWS_array + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) + b = -(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%Mean_FFWS - y2%Mean_FFWS)/t(2) - y_out%Mean_FFWS = y1%Mean_FFWS + b0 * t_out - b0 = -(y1%TI - y2%TI)/t(2) - y_out%TI = y1%TI + b0 * t_out - b0 = -(y1%TI_downstream - y2%TI_downstream)/t(2) - y_out%TI_downstream = y1%TI_downstream + b0 * t_out + b = -(y1%Mean_FFWS - y2%Mean_FFWS) + y_out%Mean_FFWS = y1%Mean_FFWS + b * ScaleFactor + b = -(y1%TI - y2%TI) + y_out%TI = y1%TI + b * ScaleFactor + b = -(y1%TI_downstream - y2%TI_downstream) + y_out%TI_downstream = y1%TI_downstream + b * ScaleFactor IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - ALLOCATE(b2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - ALLOCATE(c2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - b2 = -(y1%wake_u - y2%wake_u)/t(2) - y_out%wake_u = y1%wake_u + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) + DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) + b = -(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - ALLOCATE(b3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - ALLOCATE(c3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - b3 = -(y1%wake_position - y2%wake_position)/t(2) - y_out%wake_position = y1%wake_position + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) + DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) + DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) + b = -(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - b2 = -(y1%smoothed_velocity_array - y2%smoothed_velocity_array)/t(2) - y_out%smoothed_velocity_array = y1%smoothed_velocity_array + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) + DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) + b = -(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(y1%AtmUscale - y2%AtmUscale)/t(2) - y_out%AtmUscale = y1%AtmUscale + b0 * t_out - b0 = -(y1%du_dz_ABL - y2%du_dz_ABL)/t(2) - y_out%du_dz_ABL = y1%du_dz_ABL + b0 * t_out - b0 = -(y1%total_SDgenpwr - y2%total_SDgenpwr)/t(2) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b0 * t_out - b0 = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr)/t(2) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b0 * t_out - b0 = -(y1%avg_ct - y2%avg_ct)/t(2) - y_out%avg_ct = y1%avg_ct + b0 * t_out + b = -(y1%AtmUscale - y2%AtmUscale) + y_out%AtmUscale = y1%AtmUscale + b * ScaleFactor + b = -(y1%du_dz_ABL - y2%du_dz_ABL) + y_out%du_dz_ABL = y1%du_dz_ABL + b * ScaleFactor + b = -(y1%total_SDgenpwr - y2%total_SDgenpwr) + y_out%total_SDgenpwr = y1%total_SDgenpwr + b * ScaleFactor + b = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b * ScaleFactor + b = -(y1%avg_ct - y2%avg_ct) + y_out%avg_ct = y1%avg_ct + b * ScaleFactor CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE DWM_Output_ExtrapInterp1 @@ -9979,17 +9726,18 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -10008,104 +9756,96 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - ALLOCATE(b1(SIZE(y_out%turbine_thrust_force,1))) - ALLOCATE(c1(SIZE(y_out%turbine_thrust_force,1))) - b1 = (t(3)**2*(y1%turbine_thrust_force - y2%turbine_thrust_force) + t(2)**2*(-y1%turbine_thrust_force + y3%turbine_thrust_force))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%turbine_thrust_force + t(3)*y2%turbine_thrust_force - t(2)*y3%turbine_thrust_force ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%turbine_thrust_force = y1%turbine_thrust_force + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) + b = (t(3)**2*(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + t(2)**2*(-y1%turbine_thrust_force(i1) + y3%turbine_thrust_force(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%turbine_thrust_force(i1) + t(3)*y2%turbine_thrust_force(i1) - t(2)*y3%turbine_thrust_force(i1) ) * scaleFactor + y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - ALLOCATE(b1(SIZE(y_out%induction_factor,1))) - ALLOCATE(c1(SIZE(y_out%induction_factor,1))) - b1 = (t(3)**2*(y1%induction_factor - y2%induction_factor) + t(2)**2*(-y1%induction_factor + y3%induction_factor))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%induction_factor + t(3)*y2%induction_factor - t(2)*y3%induction_factor ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%induction_factor = y1%induction_factor + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) + b = (t(3)**2*(y1%induction_factor(i1) - y2%induction_factor(i1)) + t(2)**2*(-y1%induction_factor(i1) + y3%induction_factor(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%induction_factor(i1) + t(3)*y2%induction_factor(i1) - t(2)*y3%induction_factor(i1) ) * scaleFactor + y_out%induction_factor(i1) = y1%induction_factor(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - ALLOCATE(b1(SIZE(y_out%r_initial,1))) - ALLOCATE(c1(SIZE(y_out%r_initial,1))) - b1 = (t(3)**2*(y1%r_initial - y2%r_initial) + t(2)**2*(-y1%r_initial + y3%r_initial))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%r_initial + t(3)*y2%r_initial - t(2)*y3%r_initial ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%r_initial = y1%r_initial + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) + b = (t(3)**2*(y1%r_initial(i1) - y2%r_initial(i1)) + t(2)**2*(-y1%r_initial(i1) + y3%r_initial(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%r_initial(i1) + t(3)*y2%r_initial(i1) - t(2)*y3%r_initial(i1) ) * scaleFactor + y_out%r_initial(i1) = y1%r_initial(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - ALLOCATE(b1(SIZE(y_out%U_initial,1))) - ALLOCATE(c1(SIZE(y_out%U_initial,1))) - b1 = (t(3)**2*(y1%U_initial - y2%U_initial) + t(2)**2*(-y1%U_initial + y3%U_initial))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%U_initial + t(3)*y2%U_initial - t(2)*y3%U_initial ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%U_initial = y1%U_initial + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) + b = (t(3)**2*(y1%U_initial(i1) - y2%U_initial(i1)) + t(2)**2*(-y1%U_initial(i1) + y3%U_initial(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%U_initial(i1) + t(3)*y2%U_initial(i1) - t(2)*y3%U_initial(i1) ) * scaleFactor + y_out%U_initial(i1) = y1%U_initial(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - ALLOCATE(b1(SIZE(y_out%Mean_FFWS_array,1))) - ALLOCATE(c1(SIZE(y_out%Mean_FFWS_array,1))) - b1 = (t(3)**2*(y1%Mean_FFWS_array - y2%Mean_FFWS_array) + t(2)**2*(-y1%Mean_FFWS_array + y3%Mean_FFWS_array))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Mean_FFWS_array + t(3)*y2%Mean_FFWS_array - t(2)*y3%Mean_FFWS_array ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Mean_FFWS_array = y1%Mean_FFWS_array + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) + b = (t(3)**2*(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + t(2)**2*(-y1%Mean_FFWS_array(i1) + y3%Mean_FFWS_array(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Mean_FFWS_array(i1) + t(3)*y2%Mean_FFWS_array(i1) - t(2)*y3%Mean_FFWS_array(i1) ) * scaleFactor + y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Mean_FFWS = y1%Mean_FFWS + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TI = y1%TI + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TI_downstream = y1%TI_downstream + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))* scaleFactor + c = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) * scaleFactor + y_out%Mean_FFWS = y1%Mean_FFWS + b + c * t_out + b = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))* scaleFactor + c = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) * scaleFactor + y_out%TI = y1%TI + b + c * t_out + b = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))* scaleFactor + c = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) * scaleFactor + y_out%TI_downstream = y1%TI_downstream + b + c * t_out IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - ALLOCATE(b2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - ALLOCATE(c2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - b2 = (t(3)**2*(y1%wake_u - y2%wake_u) + t(2)**2*(-y1%wake_u + y3%wake_u))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%wake_u + t(3)*y2%wake_u - t(2)*y3%wake_u ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wake_u = y1%wake_u + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) + DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) + b = (t(3)**2*(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + t(2)**2*(-y1%wake_u(i1,i2) + y3%wake_u(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%wake_u(i1,i2) + t(3)*y2%wake_u(i1,i2) - t(2)*y3%wake_u(i1,i2) ) * scaleFactor + y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - ALLOCATE(b3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - ALLOCATE(c3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - b3 = (t(3)**2*(y1%wake_position - y2%wake_position) + t(2)**2*(-y1%wake_position + y3%wake_position))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*y1%wake_position + t(3)*y2%wake_position - t(2)*y3%wake_position ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wake_position = y1%wake_position + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) + DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) + DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) + b = (t(3)**2*(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + t(2)**2*(-y1%wake_position(i1,i2,i3) + y3%wake_position(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%wake_position(i1,i2,i3) + t(3)*y2%wake_position(i1,i2,i3) - t(2)*y3%wake_position(i1,i2,i3) ) * scaleFactor + y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - b2 = (t(3)**2*(y1%smoothed_velocity_array - y2%smoothed_velocity_array) + t(2)**2*(-y1%smoothed_velocity_array + y3%smoothed_velocity_array))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%smoothed_velocity_array + t(3)*y2%smoothed_velocity_array - t(2)*y3%smoothed_velocity_array ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%smoothed_velocity_array = y1%smoothed_velocity_array + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) + DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) + b = (t(3)**2*(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + t(2)**2*(-y1%smoothed_velocity_array(i1,i2) + y3%smoothed_velocity_array(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%smoothed_velocity_array(i1,i2) + t(3)*y2%smoothed_velocity_array(i1,i2) - t(2)*y3%smoothed_velocity_array(i1,i2) ) * scaleFactor + y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%AtmUscale = y1%AtmUscale + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%du_dz_ABL = y1%du_dz_ABL + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%avg_ct = y1%avg_ct + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))* scaleFactor + c = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) * scaleFactor + y_out%AtmUscale = y1%AtmUscale + b + c * t_out + b = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))* scaleFactor + c = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) * scaleFactor + y_out%du_dz_ABL = y1%du_dz_ABL + b + c * t_out + b = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))* scaleFactor + c = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) * scaleFactor + y_out%total_SDgenpwr = y1%total_SDgenpwr + b + c * t_out + b = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))* scaleFactor + c = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) * scaleFactor + y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b + c * t_out + b = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))* scaleFactor + c = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) * scaleFactor + y_out%avg_ct = y1%avg_ct + b + c * t_out CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE DWM_Output_ExtrapInterp2 diff --git a/modules/aerodyn14/src/GenSubs.f90 b/modules/aerodyn14/src/GenSubs.f90 index 54fe3e9f57..e02fd5cbc4 100644 --- a/modules/aerodyn14/src/GenSubs.f90 +++ b/modules/aerodyn14/src/GenSubs.f90 @@ -332,6 +332,9 @@ SUBROUTINE AllocArrays ( InitInp, P, xc, xd, z, m, y, Arg ) IF (.NOT. ALLOCATED(m%ElOut%ReyNum)) ALLOCATE ( m%ElOut%ReyNum(NumElOut) , STAT=Sttus ) IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ReyNum array.' ) + IF (.NOT. ALLOCATED(m%ElOut%Gamma)) ALLOCATE ( m%ElOut%Gamma(NumElOut) , STAT=Sttus ) + IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for Gamma array.' ) + IF (.NOT. ALLOCATED(m%ElOut%ElPrNum)) ALLOCATE ( m%ElOut%ElPrNum(NumElOut) , STAT=Sttus ) IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ElPrNum array.' ) m%ElOut%ElPrNum ( : ) = 0 @@ -462,7 +465,7 @@ SUBROUTINE ElemOpen (ElemFile, P, m, ErrStat, ErrMsg, AD14_Ver ) Frmt = '( A4, 3(A1,A2,I2.2), (: A1, A, I2.2 ) )' IF ( p%PMOMENT ) THEN - WRITE(Frmt(22:24), '(I3)') 14*m%ElOut%NumElOut + WRITE(Frmt(22:24), '(I3)') 15*m%ElOut%NumElOut WRITE(p%UnElem, Frmt) 'Time', & TAB, 'VX', p%Element%NELM, & TAB, 'VY', p%Element%NELM, & @@ -481,10 +484,11 @@ SUBROUTINE ElemOpen (ElemFile, P, m, ErrStat, ErrMsg, AD14_Ver ) TAB, 'ForcT', m%ElOut%ElPrNum(JE), & TAB, 'Pmomt', m%ElOut%ElPrNum(JE), & TAB, 'ReNum', m%ElOut%ElPrNum(JE), & + TAB, 'Gamma', m%ElOut%ElPrNum(JE), & JE = 1, m%ElOut%NumElOut ) Frmt = '( A5, 3(A1,A8), (: A1, A ) )' - WRITE(Frmt(17:19), '(I3)') 14*m%ElOut%NumElOut + WRITE(Frmt(17:19), '(I3)') 15*m%ElOut%NumElOut WRITE(p%UnElem, Frmt) '(sec)', & TAB, '('//TRIM(Dst_Unit)//'/sec)', & TAB, '('//TRIM(Dst_Unit)//'/sec)', & @@ -503,10 +507,11 @@ SUBROUTINE ElemOpen (ElemFile, P, m, ErrStat, ErrMsg, AD14_Ver ) TAB, '('//TRIM(Frc_Unit)//')', & TAB, '('//TRIM(Frc_Unit)//'-'//TRIM(Dst_Unit)//')', & TAB, '(x10^6)', & + TAB, '(m^2/sec)', & JE = 1, m%ElOut%NumElOut ) ELSE - WRITE(Frmt(22:24), '(I3)') 12*m%ElOut%NumElOut + WRITE(Frmt(22:24), '(I3)') 13*m%ElOut%NumElOut WRITE(p%UnElem, Frmt) 'Time', & TAB, 'VX', p%Element%NELM, & TAB, 'VY', p%Element%NELM, & @@ -523,10 +528,11 @@ SUBROUTINE ElemOpen (ElemFile, P, m, ErrStat, ErrMsg, AD14_Ver ) TAB, 'ForcN', m%ElOut%ElPrNum(JE), & TAB, 'ForcT', m%ElOut%ElPrNum(JE), & TAB, 'ReNum', m%ElOut%ElPrNum(JE), & + TAB, 'Gamma', m%ElOut%ElPrNum(JE), & JE = 1, m%ElOut%NumElOut ) Frmt = '( A5, 3(A1,A8), (: A1, A ) )' - WRITE(Frmt(17:19), '(I3)') 12*m%ElOut%NumElOut + WRITE(Frmt(17:19), '(I3)') 13*m%ElOut%NumElOut WRITE(p%UnElem, Frmt) '(sec)', & TAB, '('//TRIM(Dst_Unit)//'/sec)', & TAB, '('//TRIM(Dst_Unit)//'/sec)', & @@ -543,6 +549,7 @@ SUBROUTINE ElemOpen (ElemFile, P, m, ErrStat, ErrMsg, AD14_Ver ) TAB, '('//TRIM(Frc_Unit)//')', & TAB, '('//TRIM(Frc_Unit)//')', & TAB, '(x10^6)', & + TAB, '(m^2/sec)', & JE = 1, m%ElOut%NumElOut ) ENDIF @@ -596,7 +603,7 @@ SUBROUTINE ElemOut( time, P, m ) Frmt = '( F10.3, ( : A1, ES12.5 ) )' IF ( P%PMOMENT ) THEN - WRITE(Frmt(10:12), '(I3)') 14*m%ElOut%NumElOut + 3 + WRITE(Frmt(10:12), '(I3)') 15*m%ElOut%NumElOut + 3 WRITE(p%UnElem,Frmt) TIME, & TAB, m%ElOut%VXSAV, & TAB, m%ElOut%VYSAV, & @@ -615,11 +622,12 @@ SUBROUTINE ElemOut( time, P, m ) TAB, m%ElOut%DFTSAV (JE), & TAB, m%ElOut%PMM (JE), & TAB, m%ElOut%ReyNum (JE), & + TAB, m%ElOut%Gamma (JE), & JE= 1, m%ElOut%NumElOut ) ELSE - WRITE(Frmt(10:12), '(I3)') 12*m%ElOut%NumElOut + 3 + WRITE(Frmt(10:12), '(I3)') 13*m%ElOut%NumElOut + 3 WRITE(p%UnElem,Frmt) TIME, & TAB, m%ElOut%VXSAV, & TAB, m%ElOut%VYSAV, & @@ -636,6 +644,7 @@ SUBROUTINE ElemOut( time, P, m ) TAB, m%ElOut%DFNSAV (JE), & TAB, m%ElOut%DFTSAV (JE), & TAB, m%ElOut%ReyNum (JE), & + TAB, m%ElOut%Gamma (JE), & JE= 1, m%ElOut%NumElOut ) ENDIF ! PMOMENT diff --git a/modules/aerodyn14/src/Registry-AD14.txt b/modules/aerodyn14/src/Registry-AD14.txt index 992927fff0..59eceb2c7b 100644 --- a/modules/aerodyn14/src/Registry-AD14.txt +++ b/modules/aerodyn14/src/Registry-AD14.txt @@ -168,18 +168,18 @@ typedef ^ DynInflowParms IntKi MAXINFLO - 2 - #should be possible to spec with m typedef ^ DynInflowParms ReKi xMinv {maxinfl} - - #Element -typedef ^ Element ReKi A {:}{:} - - - -typedef ^ Element ReKi AP {:}{:} - - - -typedef ^ Element ReKi ALPHA {:}{:} - - - -typedef ^ Element ReKi W2 {:}{:} - - - +typedef ^ Element ReKi A {:}{:} - - - "Axial induction factor" - +typedef ^ Element ReKi AP {:}{:} - - - "Tangential induction factor" - +typedef ^ Element ReKi ALPHA {:}{:} - - - "Angle of attack" rad +typedef ^ Element ReKi W2 {:}{:} - - - "Relative velocity norm " m/s typedef ^ Element ReKi OLD_A_NS {:}{:} - - - #allocated in VIND typedef ^ Element ReKi OLD_AP_NS {:}{:} - - - #allocated in VIND -typedef ^ Element ReKi PITNOW - - - - -typedef ^ ElementParms IntKi NELM - - - - -typedef ^ ElementParms ReKi TWIST {:} - - - -typedef ^ ElementParms ReKi RELM {:} - - - -typedef ^ ElementParms ReKi HLCNST {:} - - - -typedef ^ ElementParms ReKi TLCNST {:} - - - +typedef ^ Element ReKi PITNOW :: - - - "Current pitch angle - Based on blade orientation (to verify)" rad +typedef ^ ElementParms IntKi NELM - - - - "Number of elements (constant)" - +typedef ^ ElementParms ReKi TWIST {:} - - - "Airfoil twist angle (constant)" - rad +typedef ^ ElementParms ReKi RELM {:} - - - "Radius of element (constant)" m +typedef ^ ElementParms ReKi HLCNST {:} - - - "Hub loss constant B/2*(r-rh)/rh (constant)" - +typedef ^ ElementParms ReKi TLCNST {:} - - - "Tip loss constant B/2*(R-r)/R (constant) " - #ElOutParams typedef ^ ElOutParms ReKi AAA {:} - - - @@ -196,6 +196,7 @@ typedef ^ ElOutParms ReKi DynPres {:} - - - typedef ^ ElOutParms ReKi PMM {:} - - - typedef ^ ElOutParms ReKi PITSAV {:} - - - typedef ^ ElOutParms ReKi ReyNum {:} - - - +typedef ^ ElOutParms ReKi Gamma {:} - - - "Circulation along the span, 1/2 c Vrel Cl" m^2/s typedef ^ ElOutParms ReKi SaveVX {:}{:} - - - typedef ^ ElOutParms ReKi SaveVY {:}{:} - - - typedef ^ ElOutParms ReKi SaveVZ {:}{:} - - - diff --git a/modules/aerodyn14/src/Registry-AD14AeroConf.txt b/modules/aerodyn14/src/Registry-AD14AeroConf.txt new file mode 100644 index 0000000000..920e646bcc --- /dev/null +++ b/modules/aerodyn14/src/Registry-AD14AeroConf.txt @@ -0,0 +1,56 @@ +################################################################################################################################### +# Registry for AD14AeroConf in the FAST Modularization Framework +# This Registry file is used to create MODULE AD14AeroConf_Types which contains all of the user-defined types needed in AD14AeroConf. +# This module is used within the FVW_Types and AeroDyn_Types modules. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +################################################################################################################################### +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +include Registry_NWTC_Library.txt + + +## This bit is redundant with AD14 registry. Could not figure out how to have both this and the AD14 registry use a third common chunk +# AeroDyn Subtypes +typedef AD14AeroConf/AD14AeroConf Marker Reki Position 3 0.0 - - +typedef ^ Marker ^ Orientation {3}{3} 0.0 - - +typedef ^ Marker ^ TranslationVel 3 0.0 - - +typedef ^ Marker ^ RotationVel 3 0.0 - - + + +# Airfoil +typedef AD14AeroConf/AD14AeroConf MiscVarType ReKi AL :: - - - +typedef ^ MiscVarType ReKi CD ::: - - - +typedef ^ MiscVarType ReKi CL ::: - - - +typedef ^ MiscVarType ReKi CM ::: - - - +typedef ^ MiscVarType ReKi PMC - - - - +typedef ^ MiscVarType ReKi MulTabLoc - - - - + +# Parameters: this used to be called AirFoilParms +typedef ^ ParameterType IntKi MaxTable - 20 - - +typedef ^ ParameterType IntKi NTables : - - - +typedef ^ ParameterType IntKi NLift : - - - +typedef ^ ParameterType IntKi NumCL - - - - +typedef ^ ParameterType IntKi NumFoil - - - - +typedef ^ ParameterType IntKi NFoil : - - - +typedef ^ ParameterType ReKi MulTabMet :: - - - +typedef ^ ParameterType CHARACTER(1024) FoilNm : "Number of airfoil data sets" - - + + +# Aero input-type --> this used to be called AeroConfig +typedef AD14AeroConf/AD14AeroConf InputType Marker Blade : - - - +typedef ^ InputType ^ Hub - - - - +typedef ^ InputType ^ RotorFurl - - - - +typedef ^ InputType ^ Nacelle - - - - +typedef ^ InputType ^ TailFin - - - - +typedef ^ InputType ^ Tower - - - - +typedef ^ InputType ^ SubStructure - - - - +typedef ^ InputType ^ Foundation - - - - +typedef ^ InputType ReKi BladeLength - - - - + +# Dummy outputtype so that the registry is happy +typedef AD14AeroConf/AD14AeroConf OutputType ReKi Dummy - - - - + diff --git a/modules/beamdyn/CMakeLists.txt b/modules/beamdyn/CMakeLists.txt index 28eee6db3e..dae656b088 100644 --- a/modules/beamdyn/CMakeLists.txt +++ b/modules/beamdyn/CMakeLists.txt @@ -21,6 +21,7 @@ endif() set(BD_SOURCES src/BeamDyn.f90 src/BeamDyn_IO.f90 + src/BeamDyn_BldNdOuts_IO.f90 src/BeamDyn_Subs.f90 src/BeamDyn_Types.f90 ) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index e32b4eca4f..7af5c177a2 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -17,6 +17,7 @@ !********************************************************************************************************************************** MODULE BeamDyn + USE BeamDyn_BldNdOuts_IO USE BeamDyn_IO USE BeamDyn_Subs !USE NWTC_LAPACK inherited from BeamDyn_Subs and BeamDyn_IO @@ -156,7 +157,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ENDIF ! compute physical distances to set positions of p%uuN0 (FE GLL_Nodes) (depends on p%SP_Coef): - call InitializeNodalLocations(InputFileData, p, GLL_nodes, ErrStat2,ErrMsg2) + call InitializeNodalLocations(InputFileData, p, GLL_nodes, InitOut, ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) then call cleanup() @@ -493,11 +494,12 @@ END SUBROUTINE Cleanup end subroutine InitializeMassStiffnessMatrices !----------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine computes the positions and rotations stored in p%uuN0 (output GLL nodes). -subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) +!> This subroutine computes the positions and rotations stored in p%uuN0 (output GLL nodes) and p%QuadPt (input quadrature nodes). p%QPtN must be already set. +subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,InitOut,ErrStat, ErrMsg) type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file type(BD_ParameterType), intent(inout) :: p !< Parameters REAL(BDKi), INTENT(IN ) :: GLL_nodes(:) !< GLL_nodes(p%nodes_per_elem): location of the (p%nodes_per_elem) p%GLL points + type(BD_InitOutputType), intent(inout) :: InitOut !< initialization output type (for setting z_coordinate variable) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -507,10 +509,8 @@ subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) ! local variables INTEGER(IntKi) :: i ! do-loop counter INTEGER(IntKi) :: j ! do-loop counter - INTEGER(IntKi) :: idx_qp !< index of current quadrature point in loop INTEGER(IntKi) :: member_first_kp INTEGER(IntKi) :: member_last_kp - INTEGER(IntKi) :: temp_id2 REAL(BDKi) :: eta REAL(BDKi) :: temp_POS(3) REAL(BDKi) :: temp_CRV(3) @@ -551,6 +551,63 @@ subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) ENDDO + + !!------------------------------------------------- + !! InitOut%z_coordinate contains the z coordinate (in meters) along the blade and will be used for naming output channels + !!------------------------------------------------- + ! + ! + !SELECT CASE(p%BldMotionNodeLoc) + !CASE (BD_MESH_FE) + ! CALL AllocAry( InitOut%z_coordinate, p%nodes_per_elem*p%elem_total,'InitOut%z_coordinate',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat2 >= AbortErrLev) return + ! + ! member_first_kp = 1 !first key point on member (element) + ! DO i=1,p%elem_total + ! + ! member_last_kp = member_first_kp + InputFileData%kp_member(i) - 1 !last key point of member (element) + ! DO j=1,p%nodes_per_elem + ! + ! eta = (GLL_nodes(j) + 1.0_BDKi)/2.0_BDKi ! relative location where we are on the member (element), in range [0,1] + ! InitOut%z_coordinate( (i-1)*p%nodes_per_elem + j ) = Find_InitZ(InputFileData%kp_coordinate, member_first_kp, member_last_kp, eta) + ! ENDDO + ! + ! ! set for next element: + ! member_first_kp = member_last_kp + ! + ! ENDDO + ! + ! + !CASE (BD_MESH_QP) + ! CALL AllocAry( InitOut%z_coordinate, size(p%NdIndx),'InitOut%z_coordinate',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat2 >= AbortErrLev) return + ! + ! member_first_kp = 1 + ! + ! DO i=1,p%elem_total + ! member_last_kp = member_first_kp + InputFileData%kp_member(i) - 1 + ! + ! DO idx_qp=1,p%nqp(i) + ! eta = (p%QPtN(idx_qp,i) + 1.0_BDKi)/2.0_BDKi ! translate quadrature points in [-1,1] to eta in [0,1] + ! temp_ID = SUM(p%nqp(0:i-1)) + idx_qp + p%qp_indx_offset - (i - 1)*p%qp_overlap_offset ! indx_offset=0, overlap_offset=1 for trap + ! InitOut%z_coordinate( temp_ID ) = Find_InitZ(InputFileData%kp_coordinate, member_first_kp, member_last_kp, eta) + ! ENDDO + ! + ! ! set for next element: + ! member_first_kp = member_last_kp + ! ENDDO + ! + ! IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN + ! InitOut%z_coordinate( 1 ) = InputFileData%kp_coordinate(1,3) + ! InitOut%z_coordinate( size(InitOut%z_coordinate) ) = InputFileData%kp_coordinate(InputFileData%kp_total,3) + ! ENDIF + ! + !END SELECT + + return + end subroutine InitializeNodalLocations !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the contributions of the integral of shape functions outboard of an FE node. These weighting values are @@ -722,7 +779,7 @@ END SUBROUTINE BD_InitShpDerJaco !> This subroutine initializes data in the InitOut type, which is returned to the glue code. subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) - type(BD_InitOutputType), intent( out) :: InitOut !< output data + type(BD_InitOutputType), intent(inout) :: InitOut !< output data (we've already set InitOut%z_coordinate) type(BD_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 @@ -741,11 +798,12 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) errStat = ErrID_None errMsg = "" + ! p%BldNd_BlOutNd contains the list of nodes we are outputting. At each node there are BldNd_NumOuts output channels. - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -756,12 +814,17 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) InitOut%Ver = BeamDyn_Ver + + ! Set the info in WriteOutputHdr and WriteOutputUnt for BldNd sections. + CALL BldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine SetInitOut !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine allocates and initializes most (not all) of the parameters used in BeamDyn. subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file + type(BD_InputFile), intent(inout) :: InputFileData !< data from the input file [we may need to shift the keypoint to match a MK matrix eta for trap multi-element] type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -786,7 +849,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%GlbPos = InitInp%GlbPos - ! Global rotation tensor + ! Global rotation tensor. What comes from the driver may not be a properly formed + ! DCM (may have roundoff), so recalculate it from the extracted WM parameters. p%GlbRot = TRANSPOSE(InitInp%GlbRot) ! matrix that now transfers from local to global (FAST's DCMs convert from global to local) CALL BD_CrvExtractCrv(p%GlbRot,p%Glb_crv, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -900,7 +964,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ! Set start and end node index for each elements !............................................... - ! Store the node number for first and last node in element + ! Store the node number for first and last FE node in element ! p%node_total = p%elem_total*(p%nodes_per_elem-1) + 1 is the number of GLL nodes total for the beam ! --> This assumes that the first node of element 2 is the same as the last node of element 1. ! Some subroutines are looking at a single element, in which case the values stored in p%nodes_elem_idx @@ -915,6 +979,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) CASE (BD_MESH_FE) CALL AllocAry(p%NdIndx,p%node_total,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(p%NdIndxInverse,p%elem_total*p%nodes_per_elem,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,p%node_total,'p%OutNd2NdElem',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -923,18 +989,24 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%OutNd2NdElem(:,1) = 1 ! note this is an array indx = 2 DO i=1,p%elem_total + p%NdIndxInverse((i-1)*p%nodes_per_elem + 1) = indx-1 ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + DO j=2,p%nodes_per_elem ! GLL nodes overlap at element end points; we will skip the first node of each element (after the first one) p%NdIndx(indx) = (i-1)*p%nodes_per_elem + j ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + p%NdIndxInverse(p%NdIndx(indx)) = indx ! Index from BldMotion mesh (to number of unique nodes) p%OutNd2NdElem(1,indx) = j ! Node number. To go from an output node number to a node/elem pair p%OutNd2NdElem(2,indx) = i ! Element number. To go from an output node number to a node/elem pair indx = indx + 1 END DO ENDDO - + CASE (BD_MESH_QP) + IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN nUniqueQP = p%nqp*p%elem_total + 2*p%qp_indx_offset - + + CALL AllocAry(p%NdIndxInverse, nUniqueQP,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes, a sibling of u%DistrLoad + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%NdIndx, nUniqueQP,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,nUniqueQP,'p%OutNd2NdElem',ErrStat2,ErrMsg2) @@ -943,6 +1015,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) DO i=1,nUniqueQP ! gauss quadrature doesn't have overlapping nodes p%NdIndx(i) = i + p%NdIndxInverse(i) = i END DO indx = 2 @@ -960,7 +1033,9 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ELSEIF(p%quadrature .EQ. TRAP_QUADRATURE) THEN ! at least one quadrature point associated with each blade station nUniqueQP = (p%nqp-1)*p%elem_total + 1 - + + CALL AllocAry(p%NdIndxInverse, nUniqueQP,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes, a sibling of u%DistrLoad + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%NdIndx, nUniqueQP,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,nUniqueQP,'p%OutNd2NdElem',ErrStat2,ErrMsg2) @@ -973,6 +1048,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) DO i=1,p%elem_total DO j=2,p%nqp ! trap quadrature contains overlapping nodes at element end points; we will skip the first node of each element (after the first one) p%NdIndx(indx) = (i-1)*p%nqp + j ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + p%NdIndxInverse(p%NdIndx(indx)) = indx ! Index from BldMotion mesh p%OutNd2NdElem(1,indx) = j ! Node number. To go from an output node number to a node/elem pair p%OutNd2NdElem(2,indx) = i ! Element number. To go from an output node number to a node/elem pair indx = indx + 1; @@ -1020,6 +1096,10 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return + call BldNdOuts_SetParameters(InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) ! requires p%BldNd_NumOuts, y%BldMotion + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + end subroutine SetParameters !----------------------------------------------------------------------------------------------------------------------------------- !> this routine initializes the outputs, y, that are used in the BeamDyn interface for coupling in the FAST framework. @@ -1156,13 +1236,16 @@ subroutine Init_y( p, u, y, ErrStat, ErrMsg) CALL SetErrStat(ErrID_Fatal, "Invalid p%BldMotionNodeLoc.", ErrStat, ErrMsg, RoutineName ) END SELECT + y%BldMotion%RefNode = 1 !................................. ! y%WriteOutput (for writing columns to output file) !................................. - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) + ! p%BldNd_BlOutNd contains the list of nodes we are outputting. + + call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end subroutine Init_y @@ -1409,7 +1492,7 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) CALL MeshCommit ( Mesh = u%DistrLoad & ,ErrStat = ErrStat2 & ,ErrMess = ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, 'u%DistrLoad'//ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! initial guesses u%DistrLoad%Force = 0.0_ReKi @@ -1784,7 +1867,7 @@ END SUBROUTINE BD_UpdateStates !----------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at t @@ -1798,6 +1881,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) TYPE(BD_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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call TYPE(BD_ContinuousStateType) :: x_tmp TYPE(BD_OtherStateType) :: OtherState_tmp @@ -1807,13 +1891,20 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcOutput' + LOGICAL :: CalcWriteOutput - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" AllOuts = 0.0_ReKi + + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + end if ! Since x is passed in, but we need to update it, we must work with a copy. CALL BD_CopyContState(x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -1912,19 +2003,31 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! compute RootMxr and RootMyr for ServoDyn and ! get values to output to file: !------------------------------------------------------- - call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2 ) !uses m%u2 + call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2, CalcWriteOutput ) !uses m%u2 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%RootMxr = AllOuts( RootMxr ) y%RootMyr = AllOuts( RootMyr ) - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... + if (CalcWriteOutput) then + !............................................................................................................................... + ! 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 * AllOuts( p%OutParam(i)%Indx ) + end do ! i - All selected output channels - do i = 1,p%NumOuts ! Loop through all selected output channels - y%WriteOutput(i) = p%OutParam(i)%SignM * AllOuts( p%OutParam(i)%Indx ) - end do ! i - All selected output channels + + IF( p%BldNd_NumOuts > 0 ) THEN + ! Put the values from the nodal outputs into the writeoutput array + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteBldNdOutput( p, m, y, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + end if call cleanup() @@ -2878,7 +2981,6 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) REAL(BDKi) :: b11(3,3) REAL(BDKi) :: b12(3,3) REAL(BDKi) :: alpha(3,3) - INTEGER(IntKi) :: i, j INTEGER(IntKi) :: idx_qp !< index of current quadrature point @@ -3508,7 +3610,6 @@ SUBROUTINE BD_Static(t,u,utimes,p,x,OtherState,m,ErrStat,ErrMsg) TYPE(BD_InputType) :: u_interp ! temporary copy of inputs, transferred to BD local system REAL(BDKi) :: ScaleFactor ! Factor for scaling applied loads at each step - INTEGER(IntKi) :: i INTEGER(IntKi) :: j ! Generic counters INTEGER(IntKi) :: piter REAL(BDKi) :: gravity_temp(3) @@ -3751,7 +3852,6 @@ SUBROUTINE BD_FD_Stat( x, gravity, p, m ) ! local variables INTEGER(IntKi) :: i INTEGER(IntKi) :: idx_dof - REAL(BDKi), allocatable :: RHS_m(:,:), RHS_p(:,:) CHARACTER(*), PARAMETER :: RoutineName = 'BD_FD_Stat' ! zero out the local matrices. @@ -6677,7 +6777,7 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE BD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedLogMap ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6696,6 +6796,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, 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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedLogMap !< whether a y_op values should contain log maps instead of full orientation matrices INTEGER(IntKi) :: index, i, dof INTEGER(IntKi) :: nu @@ -6704,6 +6805,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) + LOGICAL :: ReturnLogMap TYPE(BD_ContinuousStateType) :: dx ! derivative of continuous states at operating point @@ -6740,10 +6842,15 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( y_op ) ) THEN + if (present(NeedLogMap)) then + ReturnLogMap = NeedLogMap + else + ReturnLogMap = .false. + end if - ny = p%Jac_ny + y%BldMotion%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 + ny = p%Jac_ny + y%BldMotion%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -6760,10 +6867,10 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, FieldMask(MASKID_RotationVel) = .true. FieldMask(MASKID_TranslationAcc) = .true. FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask) + call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, UseLogMaps=ReturnLogMap) index = index - 1 - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 new file mode 100644 index 0000000000..9cc98cb5d4 --- /dev/null +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -0,0 +1,1494 @@ +! This module is an add on to BeamDyn to allow output of data at each blade node. +! +! Copyright (C) 2016-2017 Envision Energy USA, LTD +! +MODULE BeamDyn_BldNdOuts_IO + + USE NWTC_Library + USE NWTC_LAPACK + USE BeamDyn_Subs + USE BeamDyn_Types + + IMPLICIT NONE + + PRIVATE + + + ! Outstanding issues + ! 1. Currently nothing is added to the summary file. If we add some output there, some changes either in the BeamDyn + ! code (as distributed) will be needed, or changes here (reopen file and append). + + + PUBLIC :: BldNdOuts_InitOut + PUBLIC :: Calc_WriteBldNdOutput + PUBLIC :: BldNdOuts_SetParameters + + + + ! 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 + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 12-Dec-2017 20:48:14. + + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + + + ! Sectional Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_FxL = 1 + INTEGER(IntKi), PARAMETER :: BldNd_FyL = 2 + INTEGER(IntKi), PARAMETER :: BldNd_FzL = 3 + INTEGER(IntKi), PARAMETER :: BldNd_MxL = 4 + INTEGER(IntKi), PARAMETER :: BldNd_MyL = 5 + INTEGER(IntKi), PARAMETER :: BldNd_MzL = 6 + INTEGER(IntKi), PARAMETER :: BldNd_Fxr = 7 + INTEGER(IntKi), PARAMETER :: BldNd_Fyr = 8 + INTEGER(IntKi), PARAMETER :: BldNd_Fzr = 9 + INTEGER(IntKi), PARAMETER :: BldNd_Mxr = 10 + INTEGER(IntKi), PARAMETER :: BldNd_Myr = 11 + INTEGER(IntKi), PARAMETER :: BldNd_Mzr = 12 + + + ! Sectional Motions: + + INTEGER(IntKi), PARAMETER :: BldNd_TDxr = 13 + INTEGER(IntKi), PARAMETER :: BldNd_TDyr = 14 + INTEGER(IntKi), PARAMETER :: BldNd_TDzr = 15 + INTEGER(IntKi), PARAMETER :: BldNd_RDxr = 16 + INTEGER(IntKi), PARAMETER :: BldNd_RDyr = 17 + INTEGER(IntKi), PARAMETER :: BldNd_RDzr = 18 + INTEGER(IntKi), PARAMETER :: BldNd_AbsXg = 19 + INTEGER(IntKi), PARAMETER :: BldNd_AbsYg = 20 + INTEGER(IntKi), PARAMETER :: BldNd_AbsZg = 21 + INTEGER(IntKi), PARAMETER :: BldNd_AbsXr = 22 + INTEGER(IntKi), PARAMETER :: BldNd_AbsYr = 23 + INTEGER(IntKi), PARAMETER :: BldNd_AbsZr = 24 + INTEGER(IntKi), PARAMETER :: BldNd_TVxg = 25 + INTEGER(IntKi), PARAMETER :: BldNd_TVyg = 26 + INTEGER(IntKi), PARAMETER :: BldNd_TVzg = 27 + INTEGER(IntKi), PARAMETER :: BldNd_TVxl = 28 + INTEGER(IntKi), PARAMETER :: BldNd_TVyl = 29 + INTEGER(IntKi), PARAMETER :: BldNd_TVzl = 30 + INTEGER(IntKi), PARAMETER :: BldNd_TVxr = 31 + INTEGER(IntKi), PARAMETER :: BldNd_TVyr = 32 + INTEGER(IntKi), PARAMETER :: BldNd_TVzr = 33 + INTEGER(IntKi), PARAMETER :: BldNd_RVxg = 34 + INTEGER(IntKi), PARAMETER :: BldNd_RVyg = 35 + INTEGER(IntKi), PARAMETER :: BldNd_RVzg = 36 + INTEGER(IntKi), PARAMETER :: BldNd_RVxl = 37 + INTEGER(IntKi), PARAMETER :: BldNd_RVyl = 38 + INTEGER(IntKi), PARAMETER :: BldNd_RVzl = 39 + INTEGER(IntKi), PARAMETER :: BldNd_RVxr = 40 + INTEGER(IntKi), PARAMETER :: BldNd_RVyr = 41 + INTEGER(IntKi), PARAMETER :: BldNd_RVzr = 42 + INTEGER(IntKi), PARAMETER :: BldNd_TAxl = 43 + INTEGER(IntKi), PARAMETER :: BldNd_TAyl = 44 + INTEGER(IntKi), PARAMETER :: BldNd_TAzl = 45 + INTEGER(IntKi), PARAMETER :: BldNd_TAxr = 46 + INTEGER(IntKi), PARAMETER :: BldNd_TAyr = 47 + INTEGER(IntKi), PARAMETER :: BldNd_TAzr = 48 + INTEGER(IntKi), PARAMETER :: BldNd_RAxl = 49 + INTEGER(IntKi), PARAMETER :: BldNd_RAyl = 50 + INTEGER(IntKi), PARAMETER :: BldNd_RAzl = 51 + INTEGER(IntKi), PARAMETER :: BldNd_RAxr = 52 + INTEGER(IntKi), PARAMETER :: BldNd_RAyr = 53 + INTEGER(IntKi), PARAMETER :: BldNd_RAzr = 54 + + ! Applied Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_PFxL = 55 + INTEGER(IntKi), PARAMETER :: BldNd_PFyL = 56 + INTEGER(IntKi), PARAMETER :: BldNd_PFzL = 57 + INTEGER(IntKi), PARAMETER :: BldNd_PMxL = 58 + INTEGER(IntKi), PARAMETER :: BldNd_PMyL = 59 + INTEGER(IntKi), PARAMETER :: BldNd_PMzL = 60 + INTEGER(IntKi), PARAMETER :: BldNd_DFxL = 61 + INTEGER(IntKi), PARAMETER :: BldNd_DFyL = 62 + INTEGER(IntKi), PARAMETER :: BldNd_DFzL = 63 + INTEGER(IntKi), PARAMETER :: BldNd_DMxL = 64 + INTEGER(IntKi), PARAMETER :: BldNd_DMyL = 65 + INTEGER(IntKi), PARAMETER :: BldNd_DMzL = 66 + INTEGER(IntKi), PARAMETER :: BldNd_DFxR = 67 + INTEGER(IntKi), PARAMETER :: BldNd_DFyR = 68 + INTEGER(IntKi), PARAMETER :: BldNd_DFzR = 69 + INTEGER(IntKi), PARAMETER :: BldNd_DMxR = 70 + INTEGER(IntKi), PARAMETER :: BldNd_DMyR = 71 + INTEGER(IntKi), PARAMETER :: BldNd_DMzR = 72 + + + ! Sectional Partial Loads (debugging): + + INTEGER(IntKi), PARAMETER :: BldNd_FFbxl = 73 + INTEGER(IntKi), PARAMETER :: BldNd_FFbyl = 74 + INTEGER(IntKi), PARAMETER :: BldNd_FFbzl = 75 + INTEGER(IntKi), PARAMETER :: BldNd_FFbxr = 76 + INTEGER(IntKi), PARAMETER :: BldNd_FFbyr = 77 + INTEGER(IntKi), PARAMETER :: BldNd_FFbzr = 78 + INTEGER(IntKi), PARAMETER :: BldNd_MFbxl = 79 + INTEGER(IntKi), PARAMETER :: BldNd_MFbyl = 80 + INTEGER(IntKi), PARAMETER :: BldNd_MFbzl = 81 + INTEGER(IntKi), PARAMETER :: BldNd_MFbxr = 82 + INTEGER(IntKi), PARAMETER :: BldNd_MFbyr = 83 + INTEGER(IntKi), PARAMETER :: BldNd_MFbzr = 84 + INTEGER(IntKi), PARAMETER :: BldNd_FFcxl = 85 + INTEGER(IntKi), PARAMETER :: BldNd_FFcyl = 86 + INTEGER(IntKi), PARAMETER :: BldNd_FFczl = 87 + INTEGER(IntKi), PARAMETER :: BldNd_FFcxr = 88 + INTEGER(IntKi), PARAMETER :: BldNd_FFcyr = 89 + INTEGER(IntKi), PARAMETER :: BldNd_FFczr = 90 + INTEGER(IntKi), PARAMETER :: BldNd_MFcxl = 91 + INTEGER(IntKi), PARAMETER :: BldNd_MFcyl = 92 + INTEGER(IntKi), PARAMETER :: BldNd_MFczl = 93 + INTEGER(IntKi), PARAMETER :: BldNd_MFcxr = 94 + INTEGER(IntKi), PARAMETER :: BldNd_MFcyr = 95 + INTEGER(IntKi), PARAMETER :: BldNd_MFczr = 96 + INTEGER(IntKi), PARAMETER :: BldNd_FFdxl = 97 + INTEGER(IntKi), PARAMETER :: BldNd_FFdyl = 98 + INTEGER(IntKi), PARAMETER :: BldNd_FFdzl = 99 + INTEGER(IntKi), PARAMETER :: BldNd_FFdxr = 100 + INTEGER(IntKi), PARAMETER :: BldNd_FFdyr = 101 + INTEGER(IntKi), PARAMETER :: BldNd_FFdzr = 102 + INTEGER(IntKi), PARAMETER :: BldNd_MFdxl = 103 + INTEGER(IntKi), PARAMETER :: BldNd_MFdyl = 104 + INTEGER(IntKi), PARAMETER :: BldNd_MFdzl = 105 + INTEGER(IntKi), PARAMETER :: BldNd_MFdxr = 106 + INTEGER(IntKi), PARAMETER :: BldNd_MFdyr = 107 + INTEGER(IntKi), PARAMETER :: BldNd_MFdzr = 108 + INTEGER(IntKi), PARAMETER :: BldNd_FFgxl = 109 + INTEGER(IntKi), PARAMETER :: BldNd_FFgyl = 110 + INTEGER(IntKi), PARAMETER :: BldNd_FFgzl = 111 + INTEGER(IntKi), PARAMETER :: BldNd_FFgxr = 112 + INTEGER(IntKi), PARAMETER :: BldNd_FFgyr = 113 + INTEGER(IntKi), PARAMETER :: BldNd_FFgzr = 114 + INTEGER(IntKi), PARAMETER :: BldNd_MFgxl = 115 + INTEGER(IntKi), PARAMETER :: BldNd_MFgyl = 116 + INTEGER(IntKi), PARAMETER :: BldNd_MFgzl = 117 + INTEGER(IntKi), PARAMETER :: BldNd_MFgxr = 118 + INTEGER(IntKi), PARAMETER :: BldNd_MFgyr = 119 + INTEGER(IntKi), PARAMETER :: BldNd_MFgzr = 120 + INTEGER(IntKi), PARAMETER :: BldNd_FFixl = 121 + INTEGER(IntKi), PARAMETER :: BldNd_FFiyl = 122 + INTEGER(IntKi), PARAMETER :: BldNd_FFizl = 123 + INTEGER(IntKi), PARAMETER :: BldNd_FFixr = 124 + INTEGER(IntKi), PARAMETER :: BldNd_FFiyr = 125 + INTEGER(IntKi), PARAMETER :: BldNd_FFizr = 126 + INTEGER(IntKi), PARAMETER :: BldNd_MFixl = 127 + INTEGER(IntKi), PARAMETER :: BldNd_MFiyl = 128 + INTEGER(IntKi), PARAMETER :: BldNd_MFizl = 129 + INTEGER(IntKi), PARAMETER :: BldNd_MFixr = 130 + INTEGER(IntKi), PARAMETER :: BldNd_MFiyr = 131 + INTEGER(IntKi), PARAMETER :: BldNd_MFizr = 132 + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 132 + +!End of code generated by Matlab script +! =================================================================================================== + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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_WriteBldNdOutput routine as well. +SUBROUTINE BldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) + + + TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: ErrStat2 ! Error status code + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(1) :: ChanPrefix ! Name prefix (B#_ -- note that the B# part is added in FAST, not here) + CHARACTER(4), ALLOCATABLE :: DistStr(:) ! Array of prefix (Z######y) + CHARACTER(3) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + IF ( p%BldNd_NumOuts == 0 ) THEN + return + ENDIF + + ! create the channel names using the z-coordinate of the beam in mm + ALLOCATE( DistStr(size(p%BldNd_BlOutNd)), STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + call SetErrStat(ErrID_Fatal, 'Error allocating DistStr array.', ErrStat, ErrMsg, RoutineName) + return + END IF + + ! Warn if we will run into issues with more than 999 nodes. + IF (p%node_total > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + DO IdxNode=1,size(p%BldNd_BlOutNd) + ! Create the name prefix: + WRITE (TmpChar,'(I3.3)') IdxNode + DistStr(IdxNode) = 'N' // TmpChar + END DO + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + ! NOTE: we populate invalid names as well (some names are not valid outputs for certain configurations). That means we will have zeros in those values. + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal BeamDyn output. The WriteOutput array is sized to p%NumOuts + num(BldNdOuts) + + +! ChanPrefix = '_' !newer names have underscore character to deliniate between sections + ChanPrefix = '' + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxNode=1,size(p%BldNd_BlOutNd) + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(DistStr(IdxNode)) // p%BldNd_OutParam(IdxChan)%Name + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + + ENDDO + + ENDDO + + IF (ALLOCATED(DistStr)) DEALLOCATE(DistStr) + + +END SUBROUTINE BldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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_WriteBldNdOutput routine as well. +SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) + TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(BD_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(BD_OutputType), INTENT(INOUT) :: y ! outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + INTEGER(IntKi) :: IdxOutList ! Index within WriteOutput + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteBldNdOutput' + + + ! temporary variables for calculation + INTEGER(IntKi) :: idx_node_in_elem ! node on current element + INTEGER(IntKi) :: nelem ! current element + INTEGER(IntKi) :: idx_node ! Counter to the blade node we are on + INTEGER(IntKi) :: compIndx ! index for array component (x,y,z) + REAL(BDKi) :: Tmp33a(3,3) ! Temporary 3x4 for orientation calcs + REAL(BDKi) :: Tmp33b(3,3) ! Temporary 3x4 for orientation calcs + + REAL(BDKi) :: WM_ParamRD(3) ! Wiener Milenkovic parameters for current node, in Global coordinates + REAL(BDKi) :: temp_vec(3) ! temporary vector for orientation info. + REAL(BDKi) :: temp_vec2(3) ! temporary vector for orientation info. + REAL(BDKi) :: temp_vec3(3) ! temporary vector for orientation info. + REAL(BDKi) :: d_ref(3) ! root displacement + REAL(BDKi) :: d(3) ! displacement + + ! WM param finding + REAL(BDKi) :: RootRelOrient(3,3) + + ! Error handling + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + IF ( p%BldNd_NumOuts == 0 ) THEN + return + ENDIF + + + ! Set the root rotation DCM relative to the reference. + ! NOTE: the orientations used in this routine are DCM's. These are directly from the mesh. + call LAPACK_DGEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) + + + ! Loop over the channel sets + DO IdxChan=1,p%BldNd_NumOuts + + + ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) + ! Logic and mathematics used here come from Calc_WriteOutput + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + + CASE (0) ! This is an invalid channel so we'll just skip it + CYCLE + + !---------------------------------------- + ! Sectional translational locations and deflections (relative to the undeflected position) expressed in g + CASE (BldNd_AbsXg,BldNd_AbsYg,BldNd_AbsZg) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_AbsXg) + compIndx = 1 + CASE (BldNd_AbsYg) + compIndx = 2 + CASE (BldNd_AbsZg) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + d = y%BldMotion%TranslationDisp(:, idx_node) + d_ref = y%BldMotion%Position( :, idx_node) + ! For actual global location + temp_vec = d + d_ref + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Sectional translational locations and deflections (relative to the undeflected position) expressed in r + CASE (BldNd_TDxr,BldNd_TDyr,BldNd_TDzr,BldNd_AbsXr,BldNd_AbsYr,BldNd_AbsZr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + d = y%BldMotion%TranslationDisp(:, idx_node) - m%u2%RootMotion%TranslationDisp(:,1) + d_ref = y%BldMotion%Position( :, idx_node) - m%u2%RootMotion%Position( :,1) + ! For relative change in location + temp_vec2 = d + d_ref - matmul( RootRelOrient, d_ref ) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) + ! For actual location relative to root + temp_vec2 = d + d_ref + temp_vec3 = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_TDxr) + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_TDyr) + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_TDzr) + y%WriteOutput( IdxOutList ) = temp_vec(3) + CASE (BldNd_AbsXr) + y%WriteOutput( IdxOutList ) = temp_vec3(1) + CASE (BldNd_AbsYr) + y%WriteOutput( IdxOutList ) = temp_vec3(2) + CASE (BldNd_AbsZr) + y%WriteOutput( IdxOutList ) = temp_vec3(3) + END SELECT + ENDDO + + + + !---------------------------------------- + ! Rotational displacements as W-M parameters + CASE ( BldNd_RDxr, BldNd_RDyr, BldNd_RDzr ) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RDxr) + compIndx = 1 + CASE (BldNd_RDyr) + compIndx = 2 + CASE (BldNd_RDzr) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + + !------------------------- +!FIXME: we are not trapping errors here. Do we need to? + ! Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) expressed in r + call LAPACK_DGEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,idx_node), RootRelOrient, 0.0_BDKi, Tmp33b, ErrStat2, ErrMsg2 ) + call LAPACK_DGEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,idx_node), Tmp33b, 0.0_BDKi, Tmp33a, ErrStat2, ErrMsg2 ) + call BD_CrvExtractCrv(Tmp33a,temp_vec2, ErrStat2, ErrMsg2) ! temp_vec2 = the Wiener-Milenkovic parameters of the node's angular/rotational defelctions + WM_ParamRD = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) ! Rotate the parameters to the correct coordinate system for output + + y%WriteOutput( IdxOutList ) = WM_ParamRD(compIndx) + END DO + + + !---------------------------------------- + ! Translational Velocities, global frame + CASE (BldNd_TVxg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(1,idx_node) + ENDDO + CASE (BldNd_TVyg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(2,idx_node) + ENDDO + CASE (BldNd_TVzg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(3,idx_node) + ENDDO + !---------------------------------------- + ! Rotational Velocities, global frame + CASE (BldNd_RVxg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(1,idx_node) * R2D + ENDDO + CASE (BldNd_RVyg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(2,idx_node) * R2D + ENDDO + CASE (BldNd_RVzg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(3,idx_node) * R2D + ENDDO + + + !---------------------------------------- + ! Translational Velocities, local frame + CASE (BldNd_TVxl,BldNd_TVyl,BldNd_TVzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TVxl) + compIndx = 1 + CASE (BldNd_TVyl) + compIndx = 2 + CASE (BldNd_TVzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%TranslationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Velocities, local frame + CASE (BldNd_RVxl,BldNd_RVyl,BldNd_RVzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RVxl) + compIndx = 1 + CASE (BldNd_RVyl) + compIndx = 2 + CASE (BldNd_RVzl) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%RotationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Velocities, root frame + CASE (BldNd_TVxr,BldNd_TVyr,BldNd_TVzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TVxr) + compIndx = 1 + CASE (BldNd_TVyr) + compIndx = 2 + CASE (BldNd_TVzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%TranslationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Velocities, root frame + CASE (BldNd_RVxr,BldNd_RVyr,BldNd_RVzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RVxr) + compIndx = 1 + CASE (BldNd_RVyr) + compIndx = 2 + CASE (BldNd_RVzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%RotationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Accelerations, local frame + CASE (BldNd_TAxl, BldNd_TAyl, BldNd_TAzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TAxl) + compIndx = 1 + CASE (BldNd_TAyl) + compIndx = 2 + CASE (BldNd_TAzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%TranslationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Accelerations, local frame + CASE (BldNd_RAxl, BldNd_RAyl, BldNd_RAzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RAxl) + compIndx = 1 + CASE (BldNd_RAyl) + compIndx = 2 + CASE (BldNd_RAzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%RotationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Accelerations, root frame + CASE (BldNd_TAxr, BldNd_TAyr, BldNd_TAzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TAxr) + compIndx = 1 + CASE (BldNd_TAyr) + compIndx = 2 + CASE (BldNd_TAzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%TranslationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Accelerations, root frame + CASE (BldNd_RAxr, BldNd_RAyr, BldNd_RAzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RAxr) + compIndx = 1 + CASE (BldNd_RAyr) + compIndx = 2 + CASE (BldNd_RAzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%RotationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + !---------------------------------------- + ! Applied point forces, local coordinate system. Not used when coupled to FAST. + CASE (BldNd_PFxl,BldNd_PFyl,BldNd_PFzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_PFxl) + compIndx = 1 + CASE (BldNd_PFyl) + compIndx = 2 + CASE (BldNd_PFzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_FE) THEN + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%PointLoad%Force( :,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else ! we need to do a mesh mapping first +!FIXME: this is not implemented yet. + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + end if + + !---------------------------------------- + ! Applied point moments, local coordinate system. Not used when coupled to FAST. + CASE (BldNd_PMxl, BldNd_PMyl, BldNd_PMzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_PMxl) + compIndx = 1 + CASE (BldNd_PMyl) + compIndx = 2 + CASE (BldNd_PMzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + if (p%BldMotionNodeLoc == BD_MESH_FE) THEN + DO idx_node=1,y%BldMotion%NNodes + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%PointLoad%Moment( :,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else ! we need to do a mesh mapping first +!FIXME: this is not implemented yet. + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + end if + + !---------------------------------------- + ! Applied distributed forces (from AD15 when coupled to FAST), local frame + CASE (BldNd_DFxl,BldNd_DFyl,BldNd_DFzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DFxl) + compIndx = 1 + CASE (BldNd_DFyl) + compIndx = 2 + CASE (BldNd_DFzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%DistrLoad%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + !---------------------------------------- + ! Applied distributed moments (from AD15 when coupled to FAST), local frame + CASE (BldNd_DMxl,BldNd_DMyl,BldNd_DMzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DMxl) + compIndx = 1 + CASE (BldNd_DMyl) + compIndx = 2 + CASE (BldNd_DMzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%DistrLoad%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Applied distributed forces (from AD15 when coupled to FAST), root frame + CASE (BldNd_DFxr,BldNd_DFyr,BldNd_DFzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DFxr) + compIndx = 1 + CASE (BldNd_DFyr) + compIndx = 2 + CASE (BldNd_DFzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u2%DistrLoad%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + !---------------------------------------- + ! Applied distributed moments (from AD15 when coupled to FAST), root frame + CASE (BldNd_DMxr,BldNd_DMyr,BldNd_DMzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DMxr) + compIndx = 1 + CASE (BldNd_DMyr) + compIndx = 2 + CASE (BldNd_DMzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u2%DistrLoad%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + + !---------------------------------------- + ! Internal Forces, local + CASE (BldNd_Fxl,BldNd_Fyl,BldNd_Fzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Fxl) + compIndx = 1 + CASE (BldNd_Fyl) + compIndx = 2 + CASE (BldNd_Fzl) + compIndx = 3 + END SELECT + + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceQP(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceFE(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Moments, local + CASE (BldNd_Mxl,BldNd_Myl,BldNd_Mzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Mxl) + compIndx = 1 + CASE (BldNd_Myl) + compIndx = 2 + CASE (BldNd_Mzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceQP(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceFE(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Forces, root frame + CASE (BldNd_Fxr,BldNd_Fyr,BldNd_Fzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Fxr) + compIndx = 1 + CASE (BldNd_Fyr) + compIndx = 2 + CASE (BldNd_Fzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceQP(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceFE(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Moments, root frame + CASE (BldNd_Mxr,BldNd_Myr,BldNd_Mzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Mxr) + compIndx = 1 + CASE (BldNd_Myr) + compIndx = 2 + CASE (BldNd_Mzr) + compIndx = 3 + END SELECT + + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceQP(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceFE(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + +!>>> The remaining loads outputs are for debugging, and are not valid with BD_MESH_FE. We cannot get here in that case. + !---------------------------------------- + ! Internal forces from CalcOutput, local frame + CASE (BldNd_FFbxl,BldNd_FFbyl,BldNd_FFbzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_FFbxl) + compIndx = 1 + CASE (BldNd_FFbyl) + compIndx = 2 + CASE (BldNd_FFbzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + CASE (BldNd_MFbxl,BldNd_MFbyl,BldNd_MFbzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFbxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFbyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFbzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFcxl,BldNd_FFcyl,BldNd_FFczl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFcxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFcyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFczl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFcxl,BldNd_MFcyl,BldNd_MFczl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFcxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFcyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFczl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFdxl,BldNd_FFdyl,BldNd_FFdzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFdxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFdyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFdzl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFdxl,BldNd_MFdyl,BldNd_MFdzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFdxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFdyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFdzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFgxl,BldNd_FFgyl,BldNd_FFgzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFgxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFgyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFgzl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFgxl,BldNd_MFgyl,BldNd_MFgzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFgxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFgyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFgzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + + !---------------------------------------- + ! Internal forces from CalcOutput, local frame + CASE (BldNd_FFbxr,BldNd_FFbyr,BldNd_FFbzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFbxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFbyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFbzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFbxr,BldNd_MFbyr,BldNd_MFbzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFbxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFbyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFbzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFcxr,BldNd_FFcyr,BldNd_FFczr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFcxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFcyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFczr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFcxr,BldNd_MFcyr,BldNd_MFczr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFcxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFcyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFczr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFdxr,BldNd_FFdyr,BldNd_FFdzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFdxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFdyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFdzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFdxr,BldNd_MFdyr,BldNd_MFdzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFdxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFdyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFdzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFgxr,BldNd_FFgyr,BldNd_FFgzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFgxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFgyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFgzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFgxr,BldNd_MFgyr,BldNd_MFgzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%qp%Fg(4:6,idx_node_in_elem,nelem)) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFgxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFgyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFgzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + !---------------------------------------- + ! Inertial force from UpdateStates (Includes a few other terms), local frame + CASE (BldNd_FFixl,BldNd_FFiyl,BldNd_FFizl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFixl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFiyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFizl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFixl,BldNd_MFiyl,BldNd_MFizl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFixl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFiyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFizl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + !---------------------------------------- + ! Inertial force from UpdateStates (Includes a few other terms), root frame + CASE (BldNd_FFixr,BldNd_FFiyr,BldNd_FFizr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFixr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFiyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFizr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFixr,BldNd_MFiyr,BldNd_MFizr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFixr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFiyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFizr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + + CASE DEFAULT + CALL SetErrStat( ErrID_Severe, "Coding error. Output channel not properly set.",ErrStat,ErrMsg,RoutineName ) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + + END SELECT + + ENDDO ! Loop over the output channel list + + +END SUBROUTINE Calc_WriteBldNdOutput + +!.................................................................................................................................. +SUBROUTINE BldNdOuts_SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) + type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file + type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_SetParameters') + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + + + ! Set the parameter to store number of requested Blade Node output sets + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + + IF ( p%BldNd_NumOuts == 0 ) THEN + + p%BldNd_TotNumOuts = 0 ! default to no nodal outputs + + ELSE + + ! Check if the blade node array to output is valid: p%BldNd_BlOutNd + ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes + ! -- check if list handed in is of nodes that exist (not sure this is ever checked) + ! -- Make sure the nodes actually exist on the y%BldMotion mesh + ! -- Sort the order of the list handed in + ! -- copy values over + + + ! Temporary workaround here: + ALLOCATE ( p%BldNd_BlOutNd( size(p%NdIndxInverse) ) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the BeamDyn BldNd_BlOutNd array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + DO I=1,size(p%BldNd_BlOutNd) + p%BldNd_BlOutNd(i) = i + ENDDO + + ! Set the total number of outputs ( requested channel groups * number requested nodes ) + p%BldNd_TotNumOuts = p%BldNd_NumOuts * SIZE(p%BldNd_BlOutNd) + + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat2, ErrMsg2 ) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + END IF + + +END SUBROUTINE BldNdOuts_SetParameters +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 12-Dec-2017 20:48:14. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(BD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(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(177) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ABSXG ","ABSXR ","ABSYG ","ABSYR ","ABSZG ", & + "ABSZR ","AXB ","AXL ","AYB ","AYL ","AZB ","AZL ", & + "DFXL ","DFXR ","DFYL ","DFYR ","DFZL ","DFZR ","DMXL ", & + "DMXR ","DMYL ","DMYR ","DMZL ","DMZR ","FFBXL ","FFBXR ","FFBYL ", & + "FFBYR ","FFBZL ","FFBZR ","FFCXL ","FFCXR ","FFCYL ","FFCYR ","FFCZL ", & + "FFCZR ","FFDXL ","FFDXR ","FFDYL ","FFDYR ","FFDZL ","FFDZR ","FFGXL ", & + "FFGXR ","FFGYL ","FFGYR ","FFGZL ","FFGZR ","FFIXL ","FFIXR ","FFIYL ", & + "FFIYR ","FFIZL ","FFIZR ","FXB ","FXL ","FXR ","FYB ","FYL ", & + "FYR ","FZB ","FZL ","FZR ","MFBXL ","MFBXR ","MFBYL ","MFBYR ", & + "MFBZL ","MFBZR ","MFCXL ","MFCXR ","MFCYL ","MFCYR ","MFCZL ","MFCZR ", & + "MFDXL ","MFDXR ","MFDYL ","MFDYR ","MFDZL ","MFDZR ","MFGXL ","MFGXR ", & + "MFGYL ","MFGYR ","MFGZL ","MFGZR ","MFIXL ","MFIXR ","MFIYL ","MFIYR ", & + "MFIZL ","MFIZR ","MXB ","MXL ","MXR ","MYB ","MYL ","MYR ", & + "MZB ","MZL ","MZR ","PFXL ","PFYL ","PFZL ","PMXL ","PMYL ", & + "PMZL ","PXB ","PXG ","PYB ","PYG ","PZB ","PZG ","QXB ", & + "QXL ","QYB ","QYL ","QZB ","QZL ","RAXL ","RAXR ","RAYL ", & + "RAYR ","RAZL ","RAZR ","RDXR ","RDYR ", & + "RDZR ","RVXG ","RVXL ","RVXR ","RVYG ","RVYL ","RVYR ","RVZG ", & + "RVZL ","RVZR ","TAXL ","TAXR ","TAYL ", & + "TAYR ","TAZL ","TAZR ","TDXR ","TDYR ","TDZR ", & + "TVXG ","TVXL ","TVXR ","TVYG ","TVYL ","TVYR ","TVZG ","TVZL ", & + "TVZR ","UXB ","UYB ","UZB ","VXB ","VXG ", & + "VXL ","VYB ","VYG ","VYL ","VZB ","VZG ","VZL ","WXB ", & + "WXG ","WXL ","WYB ","WYG ","WYL ","WZB ","WZG ","WZL "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(177) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_AbsXg , BldNd_AbsXr , BldNd_AbsYg , BldNd_AbsYr , BldNd_AbsZg , & + BldNd_AbsZr , BldNd_TAxr , BldNd_TAxl , BldNd_TAyr , BldNd_TAyl , BldNd_TAzr , BldNd_TAzl , & + BldNd_DFxL , BldNd_DFxR , BldNd_DFyL , BldNd_DFyR , BldNd_DFzL , BldNd_DFzR , BldNd_DMxL , & + BldNd_DMxR , BldNd_DMyL , BldNd_DMyR , BldNd_DMzL , BldNd_DMzR , BldNd_FFbxl , BldNd_FFbxr , BldNd_FFbyl , & + BldNd_FFbyr , BldNd_FFbzl , BldNd_FFbzr , BldNd_FFcxl , BldNd_FFcxr , BldNd_FFcyl , BldNd_FFcyr , BldNd_FFczl , & + BldNd_FFczr , BldNd_FFdxl , BldNd_FFdxr , BldNd_FFdyl , BldNd_FFdyr , BldNd_FFdzl , BldNd_FFdzr , BldNd_FFgxl , & + BldNd_FFgxr , BldNd_FFgyl , BldNd_FFgyr , BldNd_FFgzl , BldNd_FFgzr , BldNd_FFixl , BldNd_FFixr , BldNd_FFiyl , & + BldNd_FFiyr , BldNd_FFizl , BldNd_FFizr , BldNd_Fxr , BldNd_FxL , BldNd_Fxr , BldNd_Fyr , BldNd_FyL , & + BldNd_Fyr , BldNd_Fzr , BldNd_FzL , BldNd_Fzr , BldNd_MFbxl , BldNd_MFbxr , BldNd_MFbyl , BldNd_MFbyr , & + BldNd_MFbzl , BldNd_MFbzr , BldNd_MFcxl , BldNd_MFcxr , BldNd_MFcyl , BldNd_MFcyr , BldNd_MFczl , BldNd_MFczr , & + BldNd_MFdxl , BldNd_MFdxr , BldNd_MFdyl , BldNd_MFdyr , BldNd_MFdzl , BldNd_MFdzr , BldNd_MFgxl , BldNd_MFgxr , & + BldNd_MFgyl , BldNd_MFgyr , BldNd_MFgzl , BldNd_MFgzr , BldNd_MFixl , BldNd_MFixr , BldNd_MFiyl , BldNd_MFiyr , & + BldNd_MFizl , BldNd_MFizr , BldNd_Mxr , BldNd_MxL , BldNd_Mxr , BldNd_Myr , BldNd_MyL , BldNd_Myr , & + BldNd_Mzr , BldNd_MzL , BldNd_Mzr , BldNd_PFxL , BldNd_PFyL , BldNd_PFzL , BldNd_PMxL , BldNd_PMyL , & + BldNd_PMzL , BldNd_AbsXr , BldNd_AbsXg , BldNd_AbsYr , BldNd_AbsYg , BldNd_AbsZr , BldNd_AbsZg , BldNd_RAxr , & + BldNd_RAxl , BldNd_RAyr , BldNd_RAyl , BldNd_RAzr , BldNd_RAzl , BldNd_RAxl , BldNd_RAxr , BldNd_RAyl , & + BldNd_RAyr , BldNd_RAzl , BldNd_RAzr , BldNd_RDxr , BldNd_RDyr , & + BldNd_RDzr , BldNd_RVxg , BldNd_RVxl , BldNd_RVxr , BldNd_RVyg , BldNd_RVyl , BldNd_RVyr , BldNd_RVzg , & + BldNd_RVzl , BldNd_RVzr , BldNd_TAxl , BldNd_TAxr , BldNd_TAyl , & + BldNd_TAyr , BldNd_TAzl , BldNd_TAzr , BldNd_TDxr , BldNd_TDyr , BldNd_TDzr , & + BldNd_TVxg , BldNd_TVxl , BldNd_TVxr , BldNd_TVyg , BldNd_TVyl , BldNd_TVyr , BldNd_TVzg , BldNd_TVzl , & + BldNd_TVzr , BldNd_TDxr , BldNd_TDyr , BldNd_TDzr , BldNd_TVxr , BldNd_TVxg , & + BldNd_TVxl , BldNd_TVyr , BldNd_TVyg , BldNd_TVyl , BldNd_TVzr , BldNd_TVzg , BldNd_TVzl , BldNd_RVxr , & + BldNd_RVxg , BldNd_RVxl , BldNd_RVyr , BldNd_RVyg , BldNd_RVyl , BldNd_RVzr , BldNd_RVzg , BldNd_RVzl /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(177) = (/ & ! This lists the units corresponding to the allowed parameters + "(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ",& + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & + "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(-) ","(-) ", & + "(-) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ", & + "(deg/s) ","(deg/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m) ","(m) ","(m) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg/s) ", & + "(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + + ! these outputs are not valid for FE (Gauss) + IF (p%BldMotionNodeLoc==BD_MESH_FE) then + InvalidOutput( BldNd_FFbxl ) = .true. + InvalidOutput( BldNd_FFbyl ) = .true. + InvalidOutput( BldNd_FFbzl ) = .true. + InvalidOutput( BldNd_MFbxl ) = .true. + InvalidOutput( BldNd_MFbyl ) = .true. + InvalidOutput( BldNd_MFbzl ) = .true. + InvalidOutput( BldNd_FFcxl ) = .true. + InvalidOutput( BldNd_FFcyl ) = .true. + InvalidOutput( BldNd_FFczl ) = .true. + InvalidOutput( BldNd_MFcxl ) = .true. + InvalidOutput( BldNd_MFcyl ) = .true. + InvalidOutput( BldNd_MFczl ) = .true. + InvalidOutput( BldNd_FFdxl ) = .true. + InvalidOutput( BldNd_FFdyl ) = .true. + InvalidOutput( BldNd_FFdzl ) = .true. + InvalidOutput( BldNd_MFdxl ) = .true. + InvalidOutput( BldNd_MFdyl ) = .true. + InvalidOutput( BldNd_MFdzl ) = .true. + InvalidOutput( BldNd_FFgxl ) = .true. + InvalidOutput( BldNd_FFgyl ) = .true. + InvalidOutput( BldNd_FFgzl ) = .true. + InvalidOutput( BldNd_MFgxl ) = .true. + InvalidOutput( BldNd_MFgyl ) = .true. + InvalidOutput( BldNd_MFgzl ) = .true. + InvalidOutput( BldNd_FFbxr ) = .true. + InvalidOutput( BldNd_FFbyr ) = .true. + InvalidOutput( BldNd_FFbzr ) = .true. + InvalidOutput( BldNd_MFbxr ) = .true. + InvalidOutput( BldNd_MFbyr ) = .true. + InvalidOutput( BldNd_MFbzr ) = .true. + InvalidOutput( BldNd_FFcxr ) = .true. + InvalidOutput( BldNd_FFcyr ) = .true. + InvalidOutput( BldNd_FFczr ) = .true. + InvalidOutput( BldNd_MFcxr ) = .true. + InvalidOutput( BldNd_MFcyr ) = .true. + InvalidOutput( BldNd_MFczr ) = .true. + InvalidOutput( BldNd_FFdxr ) = .true. + InvalidOutput( BldNd_FFdyr ) = .true. + InvalidOutput( BldNd_FFdzr ) = .true. + InvalidOutput( BldNd_MFdxr ) = .true. + InvalidOutput( BldNd_MFdyr ) = .true. + InvalidOutput( BldNd_MFdzr ) = .true. + InvalidOutput( BldNd_FFgxr ) = .true. + InvalidOutput( BldNd_FFgyr ) = .true. + InvalidOutput( BldNd_FFgzr ) = .true. + InvalidOutput( BldNd_MFgxr ) = .true. + InvalidOutput( BldNd_MFgyr ) = .true. + InvalidOutput( BldNd_MFgzr ) = .true. + InvalidOutput( BldNd_FFixl ) = .true. + InvalidOutput( BldNd_FFiyl ) = .true. + InvalidOutput( BldNd_FFizl ) = .true. + InvalidOutput( BldNd_MFixl ) = .true. + InvalidOutput( BldNd_MFiyl ) = .true. + InvalidOutput( BldNd_MFizl ) = .true. + InvalidOutput( BldNd_FFixr ) = .true. + InvalidOutput( BldNd_FFiyr ) = .true. + InvalidOutput( BldNd_FFizr ) = .true. + InvalidOutput( BldNd_MFixr ) = .true. + InvalidOutput( BldNd_MFiyr ) = .true. + InvalidOutput( BldNd_MFizr ) = .true. + END IF + IF (.NOT. (p%OutInputs .and. p%BldMotionNodeLoc/=BD_MESH_FE)) then + ! Distributed output channels not allowed yet as the mapping of the m%u_DistrLoad_at_y only exists for MESH_QP with p%OutInputs set to true + InvalidOutput( BldNd_DFxL ) = .true. + InvalidOutput( BldNd_DFyL ) = .true. + InvalidOutput( BldNd_DFzL ) = .true. + InvalidOutput( BldNd_DMxL ) = .true. + InvalidOutput( BldNd_DMyL ) = .true. + InvalidOutput( BldNd_DMzL ) = .true. + InvalidOutput( BldNd_DFxr ) = .true. + InvalidOutput( BldNd_DFyr ) = .true. + InvalidOutput( BldNd_DFzr ) = .true. + InvalidOutput( BldNd_DMxr ) = .true. + InvalidOutput( BldNd_DMyr ) = .true. + InvalidOutput( BldNd_DMzr ) = .true. + END IF + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the BeamDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%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 = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE BeamDyn_BldNdOuts_IO diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index fa838ece88..92af5a918c 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -18,6 +18,7 @@ !> This module contains the input/output parameters and routines for the BeamDyn module. MODULE BeamDyn_IO + USE BeamDyn_BldNdOuts_IO USE BeamDyn_Types USE BeamDyn_Subs USE NWTC_Library @@ -564,6 +565,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E LOGICAL :: Echo ! Determines if an echo file should be written INTEGER(IntKi) :: IOS ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsg_NoBldNdOuts ! Temporary Error message character(*), parameter :: RoutineName = 'BD_ReadPrimaryFile' CHARACTER(1024) :: PriPath ! Path name of the primary file @@ -586,6 +588,11 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL GetNewUnit(UnIn,ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL OpenFInpFile(UnIn,InputFile,ErrStat2,ErrMsg2) @@ -965,6 +972,55 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E !---------------------- END OF FILE ----------------------------------------- + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. + ErrMsg_NoBldNdOuts='Nodal outputs section of BeamDyn input file not found or improperly formatted.' + InputFileData%BldNd_NumOuts = 0 ! Just in case we don't get an error but have no nodal outputs. + + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + CALL SetErrStat( ErrID_Warn, ErrMsg_NoBldNdOuts, ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + !---------------------- END OF FILE ----------------------------------------- + + call cleanup() return @@ -1317,8 +1373,14 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( PRatAct ) = .true. InvalidOutput( PAccAct ) = .true. END IF - - + + if (p%BldMotionNodeLoc /= BD_MESH_FE) then + DO I = 1,9 + InvalidOutput( NPFl(i,:) ) = .true. + InvalidOutput( NPMl(i,:) ) = .true. + END DO + end if + ! ................. End of validity checking ................. @@ -1567,7 +1629,7 @@ SUBROUTINE BD_ValidateInputData( InitInp, InputFileData, ErrStat, ErrMsg ) END SUBROUTINE BD_ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> this routine fills the AllOuts array, which is used to send data to the glue code to be written to an output file. -SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput ) TYPE(BD_ParameterType), INTENT(IN ) :: p !< The module parameters REAL(ReKi), INTENT(INOUT) :: AllOuts(0:) !< array of values to potentially write to file @@ -1575,6 +1637,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables (for computing mesh transfers) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status code CHARACTER(*), INTENT( OUT) :: ErrMsg !< The error message, if an error occurred + LOGICAL , INTENT(IN ) :: CalcWriteOutput !< flag that determines if we need to compute AllOuts (or just the reaction loads that get returned to ServoDyn) ! local variables CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' @@ -1615,7 +1678,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) !------------------------- ! we don't need to calculate the rest of these values if we don't ask for WriteOutput channels ! (but we did need RootMxr and RootMyr) - if ( p%NumOuts <= 0 ) RETURN + if ( p%NumOuts <= 0 .or. .not. CalcWriteOutput) RETURN !------------------------- @@ -2046,6 +2109,14 @@ SUBROUTINE BD_PrintSum( p, x, m, InitInp, ErrStat, ErrMsg ) END DO + 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)') '---- --------- -----' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO if ( p%analysis_type /= BD_STATIC_ANALYSIS ) then !dynamic analysis @@ -2241,7 +2312,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! determine how many outputs there are in the Jacobians p%Jac_ny = y%ReactionForce%NNodes * 6 & ! 3 forces + 3 moments at each node + y%BldMotion%NNodes * 18 & ! 6 displacements (translation, rotation) + 6 velocities + 6 accelerations at each node - + p%NumOuts ! WriteOutput values + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values ! get the names of the linearized outputs: @@ -2256,7 +2327,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) call PackLoadMesh_Names( y%ReactionForce, 'Reaction force', InitOut%LinNames_y, index_next) call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next) - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) end do @@ -2282,6 +2353,22 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y(i+index_next-1) = AllOut( p%OutParam(i)%Indx ) end if end do + + + ! set outputs for all nodes out: + index_next = index_next + p%NumOuts + DO i=1,p%BldNd_NumOuts + ChannelName = p%BldNd_OutParam(i)%Name + call Conv2UC(ChannelName) + if ( ChannelName( LEN_TRIM(ChannelName):LEN_TRIM(ChannelName) ) == 'G') then ! channel is in global coordinate system + isRotating = .false. + else + isRotating = .true. + end if + InitOut%RotFrame_y(index_next : index_next+size(p%BldNd_BlOutNd)-1 ) = isRotating + index_next = index_next + size(p%BldNd_BlOutNd) + ENDDO + END SUBROUTINE Init_Jacobian_y !---------------------------------------------------------------------------------------------------------------------------------- @@ -2312,6 +2399,7 @@ SUBROUTINE Init_Jacobian_x_z( p, InitOut, ErrStat, ErrMsg) !call allocAry(p%dx, p%dof_node*(p%node_total-1), 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry(InitOut%LinNames_x, p%Jac_nx*2, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry(InitOut%RotFrame_x, p%Jac_nx*2, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(InitOut%DerivOrder_x, p%Jac_nx*2, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !CALL AllocAry(InitOut%LinNames_z, p%dof_node*2, 'LinNames_z', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !CALL AllocAry(InitOut%RotFrame_z, p%dof_node*2, 'RotFrame_z', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -2324,6 +2412,7 @@ SUBROUTINE Init_Jacobian_x_z( p, InitOut, ErrStat, ErrMsg) p%dx(4:6) = 0.2_BDKi*D2R_D ! deflection states in rad and rad/s InitOut%RotFrame_x = p%RotStates + InitOut%DerivOrder_x = 2 !...................................... ! set linearization output names: @@ -2378,13 +2467,8 @@ SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - INTEGER :: fieldIndx INTEGER :: node - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: angles(3) fieldIndx = p%Jac_u_indx(n,2) node = p%Jac_u_indx(n,3) @@ -2397,10 +2481,7 @@ SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) CASE ( 1) !Module/Mesh/Field: u%RootMotion%TranslationDisp = 1; u%RootMotion%TranslationDisp( fieldIndx,node) = u%RootMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign CASE ( 2) !Module/Mesh/Field: u%RootMotion%Orientation = 2; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%RootMotion%Orientation(:,:,node) = matmul(u%RootMotion%Orientation(:,:,node), orientation) + CALL PerturbOrientationMatrix( u%RootMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) CASE ( 3) !Module/Mesh/Field: u%RootMotion%TranslationVel = 3; u%RootMotion%TranslationVel( fieldIndx,node) = u%RootMotion%TranslationVel( fieldIndx,node) + du * perturb_sign CASE ( 4) !Module/Mesh/Field: u%RootMotion%RotationVel = 4; @@ -2442,7 +2523,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) call PackLoadMesh_dY( y_p%ReactionForce, y_m%ReactionForce, dY, indx_first) call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first) ! all 6 motion fields - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) end do @@ -2469,9 +2550,7 @@ SUBROUTINE Perturb_x( p, fieldIndx, node, dof, perturb_sign, x, dx ) character(ErrMsgLen) :: ErrMsg2 REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: oldRotation(3,3) - REAL(R8Ki) :: newRotation(3,3) - REAL(R8Ki) :: angles(3) + REAL(R8Ki) :: rotation(3,3) dx = p%dx(dof) @@ -2479,16 +2558,13 @@ SUBROUTINE Perturb_x( p, fieldIndx, node, dof, perturb_sign, x, dx ) if (dof < 4) then ! translational displacement x%q( dof, node ) = x%q( dof, node ) + dx * perturb_sign else ! w-m parameters - angles = 0.0_R8Ki - angles(dof-3) = dx * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - - call BD_CrvMatrixR( x%q( 4:6, node ), oldRotation ) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter - - !newRotation = transpose( matmul(transpose(oldRotation), orientation) ) - newRotation = matmul( transpose(orientation), oldRotation) - call BD_CrvExtractCrv( newRotation, x%q( 4:6, node ), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation + call BD_CrvMatrixR( x%q( 4:6, node ), rotation ) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter + orientation = transpose(rotation) + CALL PerturbOrientationMatrix( orientation, dx * perturb_sign, dof-3 ) + + rotation = transpose(orientation) + call BD_CrvExtractCrv( rotation, x%q( 4:6, node ), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation end if else x%dqdt( dof, node ) = x%dqdt( dof, node ) + dx * perturb_sign diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 479af5c5df..378cf40104 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -69,6 +69,7 @@ MODULE BeamDyn_Types 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 BD_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -117,6 +118,10 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] CHARACTER(20) :: OutFmt !< Format specifier [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (BD_BldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] END TYPE BD_InputFile ! ======================= ! ========= BD_ContinuousStateType ======= @@ -201,6 +206,7 @@ MODULE BeamDyn_Types INTEGER(IntKi) :: NNodeOuts !< Number of nodes to output data to a file[0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] CHARACTER(20) :: OutFmt !< Format specifier [-] LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] @@ -215,6 +221,10 @@ MODULE BeamDyn_Types LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + INTEGER(IntKi) :: BldNd_NumOuts !< [BD_BldNdOuts] Number of requested output channels per blade node [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< [BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< [BD_BldNdOuts] The blade nodes to actually output [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_Shp_Shp_Jac !< optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: QPtw_Shp_ShpDer !< optimization variable: QPtw_Shp_ShpDer(idx_qp,i,j) = p%Shp(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp) [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_ShpDer_ShpDer_Jac !< optimization variable: QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = p%ShpDer(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp)/p%Jacobian(idx_qp,nelem) [-] @@ -442,34 +452,56 @@ SUBROUTINE BD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%gravity))-1 ) = PACK(InData%gravity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%gravity) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GlbPos))-1 ) = PACK(InData%GlbPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GlbPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbRot))-1 ) = PACK(InData%GlbRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbRot) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RootDisp))-1 ) = PACK(InData%RootDisp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RootDisp) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RootOri))-1 ) = PACK(InData%RootOri,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RootOri) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootVel))-1 ) = PACK(InData%RootVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPos))-1 ) = PACK(InData%HubPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%HubRot))-1 ) = PACK(InData%HubRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%HubRot) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynamicSolve , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) + ReKiBuf(Re_Xferred) = InData%gravity(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) + ReKiBuf(Re_Xferred) = InData%GlbPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) + DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) + DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%RootDisp,1), UBOUND(InData%RootDisp,1) + DbKiBuf(Db_Xferred) = InData%RootDisp(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%RootOri,2), UBOUND(InData%RootOri,2) + DO i1 = LBOUND(InData%RootOri,1), UBOUND(InData%RootOri,1) + DbKiBuf(Db_Xferred) = InData%RootOri(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%RootVel,1), UBOUND(InData%RootVel,1) + ReKiBuf(Re_Xferred) = InData%RootVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%HubPos,1), UBOUND(InData%HubPos,1) + ReKiBuf(Re_Xferred) = InData%HubPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%HubRot,2), UBOUND(InData%HubRot,2) + DO i1 = LBOUND(InData%HubRot,1), UBOUND(InData%HubRot,1) + DbKiBuf(Db_Xferred) = InData%HubRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynamicSolve, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackInitInput SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -485,12 +517,6 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -508,112 +534,78 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%gravity,1) i1_u = UBOUND(OutData%gravity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%gravity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%gravity))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%gravity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) + OutData%gravity(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbPos,1) i1_u = UBOUND(OutData%GlbPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GlbPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GlbPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GlbPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) + OutData%GlbPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbRot,1) i1_u = UBOUND(OutData%GlbRot,1) i2_l = LBOUND(OutData%GlbRot,2) i2_u = UBOUND(OutData%GlbRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GlbRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) + DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) + OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RootDisp,1) i1_u = UBOUND(OutData%RootDisp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootDisp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RootDisp))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RootDisp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RootDisp,1), UBOUND(OutData%RootDisp,1) + OutData%RootDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%RootOri,1) i1_u = UBOUND(OutData%RootOri,1) i2_l = LBOUND(OutData%RootOri,2) i2_u = UBOUND(OutData%RootOri,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RootOri = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RootOri))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RootOri) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RootOri,2), UBOUND(OutData%RootOri,2) + DO i1 = LBOUND(OutData%RootOri,1), UBOUND(OutData%RootOri,1) + OutData%RootOri(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RootVel,1) i1_u = UBOUND(OutData%RootVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RootVel,1), UBOUND(OutData%RootVel,1) + OutData%RootVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubPos,1) i1_u = UBOUND(OutData%HubPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) + OutData%HubPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubRot,1) i1_u = UBOUND(OutData%HubRot,1) i2_l = LBOUND(OutData%HubRot,2) i2_u = UBOUND(OutData%HubRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HubRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%HubRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%HubRot) - DEALLOCATE(mask2) - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynamicSolve = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%HubRot,2), UBOUND(OutData%HubRot,2) + DO i1 = LBOUND(OutData%HubRot,1), UBOUND(OutData%HubRot,1) + OutData%HubRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%DynamicSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynamicSolve) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackInitInput SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -757,6 +749,18 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er END IF END IF DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) + i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN + ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x ENDIF END SUBROUTINE BD_CopyInitOutput @@ -799,6 +803,9 @@ SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN DEALLOCATE(InitOutputData%IsLoad_u) +ENDIF +IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN + DEALLOCATE(InitOutputData%DerivOrder_x) ENDIF END SUBROUTINE BD_DestroyInitOutput @@ -906,6 +913,11 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 @@ -943,12 +955,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -960,12 +972,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1008,11 +1020,15 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_coordinate)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kp_coordinate))-1 ) = PACK(InData%kp_coordinate,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kp_coordinate) + DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) + DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) + DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%kp_total - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%kp_total + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1023,12 +1039,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1040,12 +1056,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1057,12 +1073,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1074,8 +1090,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + 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 @@ -1087,8 +1105,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + 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 @@ -1100,8 +1120,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1113,8 +1135,25 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE BD_PackInitOutput @@ -1131,12 +1170,6 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1165,19 +1198,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1192,19 +1218,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1262,18 +1281,15 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%kp_coordinate)>0) OutData%kp_coordinate = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kp_coordinate))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kp_coordinate) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) + DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) + OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - OutData%kp_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%kp_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1287,19 +1303,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1314,19 +1323,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1341,19 +1343,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1368,15 +1363,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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 @@ -1391,15 +1381,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + 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 @@ -1414,15 +1399,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -1437,15 +1417,28 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + 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 mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE BD_UnPackInitOutput @@ -1617,10 +1610,10 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%station_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%format_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%station_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%format_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%station_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1631,8 +1624,10 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%station_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%station_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%station_eta))-1 ) = PACK(InData%station_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%station_eta) + DO i1 = LBOUND(InData%station_eta,1), UBOUND(InData%station_eta,1) + DbKiBuf(Db_Xferred) = InData%station_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%stiff0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1650,8 +1645,14 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%stiff0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%stiff0))-1 ) = PACK(InData%stiff0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%stiff0) + DO i3 = LBOUND(InData%stiff0,3), UBOUND(InData%stiff0,3) + DO i2 = LBOUND(InData%stiff0,2), UBOUND(InData%stiff0,2) + DO i1 = LBOUND(InData%stiff0,1), UBOUND(InData%stiff0,1) + DbKiBuf(Db_Xferred) = InData%stiff0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%mass0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1669,13 +1670,21 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mass0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mass0))-1 ) = PACK(InData%mass0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mass0) + DO i3 = LBOUND(InData%mass0,3), UBOUND(InData%mass0,3) + DO i2 = LBOUND(InData%mass0,2), UBOUND(InData%mass0,2) + DO i1 = LBOUND(InData%mass0,1), UBOUND(InData%mass0,1) + DbKiBuf(Db_Xferred) = InData%mass0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%beta))-1 ) = PACK(InData%beta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%beta) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) + DbKiBuf(Db_Xferred) = InData%beta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%damp_flag + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackBladeInputData SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1691,12 +1700,6 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1713,10 +1716,10 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%station_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%format_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%station_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%format_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! station_eta not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1730,15 +1733,10 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%station_eta)>0) OutData%station_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%station_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%station_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%station_eta,1), UBOUND(OutData%station_eta,1) + OutData%station_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! stiff0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1759,15 +1757,14 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%stiff0)>0) OutData%stiff0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%stiff0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%stiff0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%stiff0,3), UBOUND(OutData%stiff0,3) + DO i2 = LBOUND(OutData%stiff0,2), UBOUND(OutData%stiff0,2) + DO i1 = LBOUND(OutData%stiff0,1), UBOUND(OutData%stiff0,1) + OutData%stiff0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mass0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1788,29 +1785,23 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%mass0)>0) OutData%mass0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mass0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mass0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%mass0,3), UBOUND(OutData%mass0,3) + DO i2 = LBOUND(OutData%mass0,2), UBOUND(OutData%mass0,2) + DO i1 = LBOUND(OutData%mass0,1), UBOUND(OutData%mass0,1) + OutData%mass0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%beta,1) i1_u = UBOUND(OutData%beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%beta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%beta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%beta) - DEALLOCATE(mask1) - OutData%damp_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) + OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%damp_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackBladeInputData SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -1899,6 +1890,32 @@ SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF +IF (ALLOCATED(SrcInputFileData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcInputFileData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_BlOutNd)) THEN + ALLOCATE(DstInputFileData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str END SUBROUTINE BD_CopyInputFile SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -1919,6 +1936,12 @@ SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_BlOutNd)) THEN + DEALLOCATE(InputFileData%BldNd_BlOutNd) ENDIF END SUBROUTINE BD_DestroyInputFile @@ -2019,6 +2042,18 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Int_BufSz = Int_BufSz + 1 ! SumPrint Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2046,10 +2081,10 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%member_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%kp_total - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%member_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%kp_total + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%kp_member) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2060,25 +2095,27 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_member,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_member)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%kp_member))-1 ) = PACK(InData%kp_member,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%kp_member) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%order_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%load_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NRMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%refine - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTBeam - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%kp_member,1), UBOUND(InData%kp_member,1) + IntKiBuf(Int_Xferred) = InData%kp_member(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%order_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%load_retries + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NRMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%quadrature + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_fact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%refine + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rhoinf + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTBeam + Db_Xferred = Db_Xferred + 1 CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2107,20 +2144,20 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%BldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UsePitchAct , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%QuasiStaticInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%stop_tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%BldFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%QuasiStaticInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%stop_tol + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_pert + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2134,31 +2171,37 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_coordinate)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kp_coordinate))-1 ) = PACK(InData%kp_coordinate,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kp_coordinate) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchJ - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchK - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchC - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RotStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RelStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_fd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_comp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd))-1 ) = PACK(InData%OutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) + DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) + DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%pitchJ + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitchK + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitchC + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodeOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) + IntKiBuf(Int_Xferred) = InData%OutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2169,19 +2212,57 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_PackInputFile SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2197,12 +2278,6 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2218,10 +2293,10 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%member_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%kp_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%member_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%kp_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_member not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2235,32 +2310,27 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%kp_member)>0) OutData%kp_member = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%kp_member))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%kp_member) - DEALLOCATE(mask1) - END IF - OutData%order_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%load_retries = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NRMax = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%refine = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rhoinf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DTBeam = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%kp_member,1), UBOUND(OutData%kp_member,1) + OutData%kp_member(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%order_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%load_retries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NRMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%quadrature = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_fact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%refine = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rhoinf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTBeam = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2301,20 +2371,20 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%BldFile) - OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%QuasiStaticInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%stop_tol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_pert = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%BldFile) + OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) + Int_Xferred = Int_Xferred + 1 + OutData%QuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%QuasiStaticInit) + Int_Xferred = Int_Xferred + 1 + OutData%stop_tol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2331,47 +2401,39 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%kp_coordinate)>0) OutData%kp_coordinate = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kp_coordinate))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kp_coordinate) - DEALLOCATE(mask2) - END IF - OutData%pitchJ = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchK = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchC = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodeOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) + DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) + OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + OutData%pitchJ = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%pitchK = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%pitchC = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) + Int_Xferred = Int_Xferred + 1 + OutData%NNodeOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutNd,1) i1_u = UBOUND(OutData%OutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) + OutData%OutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2385,26 +2447,63 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_UnPackInputFile SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2555,8 +2654,12 @@ SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%q) + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + DbKiBuf(Db_Xferred) = InData%q(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%dqdt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2571,8 +2674,12 @@ SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dqdt)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dqdt))-1 ) = PACK(InData%dqdt,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dqdt) + DO i2 = LBOUND(InData%dqdt,2), UBOUND(InData%dqdt,2) + DO i1 = LBOUND(InData%dqdt,1), UBOUND(InData%dqdt,1) + DbKiBuf(Db_Xferred) = InData%dqdt(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BD_PackContState @@ -2589,12 +2696,6 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2626,15 +2727,12 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q)>0) OutData%q = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%q))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%q) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dqdt not allocated Int_Xferred = Int_Xferred + 1 @@ -2652,15 +2750,12 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%dqdt)>0) OutData%dqdt = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dqdt))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dqdt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%dqdt,2), UBOUND(OutData%dqdt,2) + DO i1 = LBOUND(OutData%dqdt,1), UBOUND(OutData%dqdt,1) + OutData%dqdt(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BD_UnPackContState @@ -2757,10 +2852,10 @@ SUBROUTINE BD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%thetaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%thetaPD - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%thetaP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%thetaPD + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_PackDiscState SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2776,12 +2871,6 @@ SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackDiscState' @@ -2795,10 +2884,10 @@ SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%thetaP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%thetaPD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%thetaP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%thetaPD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_UnPackDiscState SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2892,8 +2981,8 @@ SUBROUTINE BD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_PackConstrState SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2909,12 +2998,6 @@ SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackConstrState' @@ -2928,8 +3011,8 @@ SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_UnPackConstrState SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3084,8 +3167,12 @@ SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%acc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%acc))-1 ) = PACK(InData%acc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%acc) + DO i2 = LBOUND(InData%acc,2), UBOUND(InData%acc,2) + DO i1 = LBOUND(InData%acc,1), UBOUND(InData%acc,1) + DbKiBuf(Db_Xferred) = InData%acc(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%xcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3100,13 +3187,17 @@ SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xcc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%xcc))-1 ) = PACK(InData%xcc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%xcc) + DO i2 = LBOUND(InData%xcc,2), UBOUND(InData%xcc,2) + DO i1 = LBOUND(InData%xcc,1), UBOUND(InData%xcc,1) + DbKiBuf(Db_Xferred) = InData%xcc(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%InitAcc , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RunQuasiStaticInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InitAcc, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RunQuasiStaticInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackOtherState SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3122,12 +3213,6 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3159,15 +3244,12 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%acc)>0) OutData%acc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%acc))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%acc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%acc,2), UBOUND(OutData%acc,2) + DO i1 = LBOUND(OutData%acc,1), UBOUND(OutData%acc,1) + OutData%acc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xcc not allocated Int_Xferred = Int_Xferred + 1 @@ -3185,20 +3267,17 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%xcc)>0) OutData%xcc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%xcc))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%xcc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xcc,2), UBOUND(OutData%xcc,2) + DO i1 = LBOUND(OutData%xcc,1), UBOUND(OutData%xcc,1) + OutData%xcc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - OutData%InitAcc = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RunQuasiStaticInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%InitAcc = TRANSFER(IntKiBuf(Int_Xferred), OutData%InitAcc) + Int_Xferred = Int_Xferred + 1 + OutData%RunQuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%RunQuasiStaticInit) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackOtherState SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) @@ -3352,8 +3431,12 @@ SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mmm)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mmm))-1 ) = PACK(InData%mmm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mmm) + DO i2 = LBOUND(InData%mmm,2), UBOUND(InData%mmm,2) + DO i1 = LBOUND(InData%mmm,1), UBOUND(InData%mmm,1) + DbKiBuf(Db_Xferred) = InData%mmm(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%mEta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3371,8 +3454,14 @@ SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mEta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mEta))-1 ) = PACK(InData%mEta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mEta) + DO i3 = LBOUND(InData%mEta,3), UBOUND(InData%mEta,3) + DO i2 = LBOUND(InData%mEta,2), UBOUND(InData%mEta,2) + DO i1 = LBOUND(InData%mEta,1), UBOUND(InData%mEta,1) + DbKiBuf(Db_Xferred) = InData%mEta(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE BD_PackqpParam @@ -3389,12 +3478,6 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -3427,15 +3510,12 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%mmm)>0) OutData%mmm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mmm))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mmm) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%mmm,2), UBOUND(OutData%mmm,2) + DO i1 = LBOUND(OutData%mmm,1), UBOUND(OutData%mmm,1) + OutData%mmm(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mEta not allocated Int_Xferred = Int_Xferred + 1 @@ -3456,15 +3536,14 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%mEta)>0) OutData%mEta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mEta))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mEta) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%mEta,3), UBOUND(OutData%mEta,3) + DO i2 = LBOUND(OutData%mEta,2), UBOUND(OutData%mEta,2) + DO i1 = LBOUND(OutData%mEta,1), UBOUND(OutData%mEta,1) + OutData%mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE BD_UnPackqpParam @@ -3762,6 +3841,18 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%NdIndx = SrcParamData%NdIndx ENDIF +IF (ALLOCATED(SrcParamData%NdIndxInverse)) THEN + i1_l = LBOUND(SrcParamData%NdIndxInverse,1) + i1_u = UBOUND(SrcParamData%NdIndxInverse,1) + IF (.NOT. ALLOCATED(DstParamData%NdIndxInverse)) THEN + ALLOCATE(DstParamData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse +ENDIF IF (ALLOCATED(SrcParamData%OutNd2NdElem)) THEN i1_l = LBOUND(SrcParamData%OutNd2NdElem,1) i1_u = UBOUND(SrcParamData%OutNd2NdElem,1) @@ -3791,8 +3882,38 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol -IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN + ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd +ENDIF +IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN + i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) i1_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) i2_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) i2_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) @@ -3983,10 +4104,22 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%NdIndx)) THEN DEALLOCATE(ParamData%NdIndx) ENDIF +IF (ALLOCATED(ParamData%NdIndxInverse)) THEN + DEALLOCATE(ParamData%NdIndxInverse) +ENDIF IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN DEALLOCATE(ParamData%OutNd2NdElem) ENDIF CALL BD_Destroyqpparam( ParamData%qp, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN + DEALLOCATE(ParamData%BldNd_BlOutNd) +ENDIF IF (ALLOCATED(ParamData%QPtw_Shp_Shp_Jac)) THEN DEALLOCATE(ParamData%QPtw_Shp_Shp_Jac) ENDIF @@ -4184,6 +4317,11 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! NdIndx upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%NdIndx) ! NdIndx END IF + Int_BufSz = Int_BufSz + 1 ! NdIndxInverse allocated yes/no + IF ( ALLOCATED(InData%NdIndxInverse) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NdIndxInverse upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NdIndxInverse) ! NdIndxInverse + END IF Int_BufSz = Int_BufSz + 1 ! OutNd2NdElem allocated yes/no IF ( ALLOCATED(InData%OutNd2NdElem) ) THEN Int_BufSz = Int_BufSz + 2*2 ! OutNd2NdElem upper/lower bounds for each dimension @@ -4218,6 +4356,36 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no IF ( ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN Int_BufSz = Int_BufSz + 2*4 ! QPtw_Shp_Shp_Jac upper/lower bounds for each dimension @@ -4290,12 +4458,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%coef))-1 ) = PACK(InData%coef,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%coef) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%coef,1), UBOUND(InData%coef,1) + DbKiBuf(Db_Xferred) = InData%coef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%rhoinf + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%uuN0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4312,8 +4482,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uuN0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uuN0))-1 ) = PACK(InData%uuN0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uuN0) + DO i3 = LBOUND(InData%uuN0,3), UBOUND(InData%uuN0,3) + DO i2 = LBOUND(InData%uuN0,2), UBOUND(InData%uuN0,2) + DO i1 = LBOUND(InData%uuN0,1), UBOUND(InData%uuN0,1) + DbKiBuf(Db_Xferred) = InData%uuN0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stif0_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4331,8 +4507,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stif0_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Stif0_QP))-1 ) = PACK(InData%Stif0_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Stif0_QP) + DO i3 = LBOUND(InData%Stif0_QP,3), UBOUND(InData%Stif0_QP,3) + DO i2 = LBOUND(InData%Stif0_QP,2), UBOUND(InData%Stif0_QP,2) + DO i1 = LBOUND(InData%Stif0_QP,1), UBOUND(InData%Stif0_QP,1) + DbKiBuf(Db_Xferred) = InData%Stif0_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Mass0_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4350,11 +4532,19 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mass0_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Mass0_QP))-1 ) = PACK(InData%Mass0_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Mass0_QP) + DO i3 = LBOUND(InData%Mass0_QP,3), UBOUND(InData%Mass0_QP,3) + DO i2 = LBOUND(InData%Mass0_QP,2), UBOUND(InData%Mass0_QP,2) + DO i1 = LBOUND(InData%Mass0_QP,1), UBOUND(InData%Mass0_QP,1) + DbKiBuf(Db_Xferred) = InData%Mass0_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%gravity))-1 ) = PACK(InData%gravity,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%gravity) + DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) + DbKiBuf(Db_Xferred) = InData%gravity(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%segment_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4365,8 +4555,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%segment_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%segment_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%segment_eta))-1 ) = PACK(InData%segment_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%segment_eta) + DO i1 = LBOUND(InData%segment_eta,1), UBOUND(InData%segment_eta,1) + DbKiBuf(Db_Xferred) = InData%segment_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%member_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4378,27 +4570,45 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%member_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%member_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%member_eta))-1 ) = PACK(InData%member_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%member_eta) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%blade_length - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%blade_mass - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%blade_CG))-1 ) = PACK(InData%blade_CG,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%blade_CG) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%blade_IN))-1 ) = PACK(InData%blade_IN,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%blade_IN) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%beta))-1 ) = PACK(InData%beta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%beta) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbPos))-1 ) = PACK(InData%GlbPos,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbRot))-1 ) = PACK(InData%GlbRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbRot) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Glb_crv))-1 ) = PACK(InData%Glb_crv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Glb_crv) + DO i1 = LBOUND(InData%member_eta,1), UBOUND(InData%member_eta,1) + DbKiBuf(Db_Xferred) = InData%member_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%blade_length + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%blade_mass + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%blade_CG,1), UBOUND(InData%blade_CG,1) + DbKiBuf(Db_Xferred) = InData%blade_CG(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%blade_IN,2), UBOUND(InData%blade_IN,2) + DO i1 = LBOUND(InData%blade_IN,1), UBOUND(InData%blade_IN,1) + DbKiBuf(Db_Xferred) = InData%blade_IN(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) + DbKiBuf(Db_Xferred) = InData%beta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%tol + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) + DbKiBuf(Db_Xferred) = InData%GlbPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) + DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) + DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%Glb_crv,1), UBOUND(InData%Glb_crv,1) + DbKiBuf(Db_Xferred) = InData%Glb_crv(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4409,8 +4619,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtN)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtN))-1 ) = PACK(InData%QPtN,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtN) + DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) + DbKiBuf(Db_Xferred) = InData%QPtN(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtWeight) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4422,8 +4634,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtWeight,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtWeight)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtWeight))-1 ) = PACK(InData%QPtWeight,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtWeight) + DO i1 = LBOUND(InData%QPtWeight,1), UBOUND(InData%QPtWeight,1) + DbKiBuf(Db_Xferred) = InData%QPtWeight(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Shp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4438,8 +4652,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Shp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Shp))-1 ) = PACK(InData%Shp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Shp) + DO i2 = LBOUND(InData%Shp,2), UBOUND(InData%Shp,2) + DO i1 = LBOUND(InData%Shp,1), UBOUND(InData%Shp,1) + DbKiBuf(Db_Xferred) = InData%Shp(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4454,8 +4672,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ShpDer))-1 ) = PACK(InData%ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ShpDer) + DO i2 = LBOUND(InData%ShpDer,2), UBOUND(InData%ShpDer,2) + DO i1 = LBOUND(InData%ShpDer,1), UBOUND(InData%ShpDer,1) + DbKiBuf(Db_Xferred) = InData%ShpDer(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jacobian) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4470,8 +4692,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jacobian)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Jacobian))-1 ) = PACK(InData%Jacobian,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Jacobian) + DO i2 = LBOUND(InData%Jacobian,2), UBOUND(InData%Jacobian,2) + DO i1 = LBOUND(InData%Jacobian,1), UBOUND(InData%Jacobian,1) + DbKiBuf(Db_Xferred) = InData%Jacobian(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%uu0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4489,8 +4715,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uu0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uu0))-1 ) = PACK(InData%uu0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uu0) + DO i3 = LBOUND(InData%uu0,3), UBOUND(InData%uu0,3) + DO i2 = LBOUND(InData%uu0,2), UBOUND(InData%uu0,2) + DO i1 = LBOUND(InData%uu0,1), UBOUND(InData%uu0,1) + DbKiBuf(Db_Xferred) = InData%uu0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rrN0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4508,8 +4740,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rrN0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rrN0))-1 ) = PACK(InData%rrN0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rrN0) + DO i3 = LBOUND(InData%rrN0,3), UBOUND(InData%rrN0,3) + DO i2 = LBOUND(InData%rrN0,2), UBOUND(InData%rrN0,2) + DO i1 = LBOUND(InData%rrN0,1), UBOUND(InData%rrN0,1) + DbKiBuf(Db_Xferred) = InData%rrN0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%E10) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4527,8 +4765,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%E10)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%E10))-1 ) = PACK(InData%E10,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%E10) + DO i3 = LBOUND(InData%E10,3), UBOUND(InData%E10,3) + DO i2 = LBOUND(InData%E10,2), UBOUND(InData%E10,2) + DO i1 = LBOUND(InData%E10,1), UBOUND(InData%E10,1) + DbKiBuf(Db_Xferred) = InData%E10(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SP_Coef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4546,11 +4790,17 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SP_Coef,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SP_Coef)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SP_Coef))-1 ) = PACK(InData%SP_Coef,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SP_Coef) + DO i3 = LBOUND(InData%SP_Coef,3), UBOUND(InData%SP_Coef,3) + DO i2 = LBOUND(InData%SP_Coef,2), UBOUND(InData%SP_Coef,2) + DO i1 = LBOUND(InData%SP_Coef,1), UBOUND(InData%SP_Coef,1) + DbKiBuf(Db_Xferred) = InData%SP_Coef(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nodes_per_elem - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nodes_per_elem + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%node_elem_idx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4564,41 +4814,45 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%node_elem_idx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%node_elem_idx))-1 ) = PACK(InData%node_elem_idx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%node_elem_idx) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%refine - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_node - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%rot_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%elem_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%node_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nqp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%analysis_type - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ld_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%niter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutInputs , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%node_elem_idx,2), UBOUND(InData%node_elem_idx,2) + DO i1 = LBOUND(InData%node_elem_idx,1), UBOUND(InData%node_elem_idx,1) + IntKiBuf(Int_Xferred) = InData%node_elem_idx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%refine + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_node + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%rot_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%elem_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%node_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nqp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%analysis_type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%damp_flag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ld_retries + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%niter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%quadrature + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_fact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutInputs, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4640,10 +4894,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd))-1 ) = PACK(InData%OutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd) + IntKiBuf(Int_Xferred) = InData%NNodeOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) + IntKiBuf(Int_Xferred) = InData%OutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%NdIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4654,8 +4910,25 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NdIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NdIndx))-1 ) = PACK(InData%NdIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NdIndx) + DO i1 = LBOUND(InData%NdIndx,1), UBOUND(InData%NdIndx,1) + IntKiBuf(Int_Xferred) = InData%NdIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NdIndxInverse) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndxInverse,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndxInverse,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NdIndxInverse,1), UBOUND(InData%NdIndxInverse,1) + IntKiBuf(Int_Xferred) = InData%NdIndxInverse(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4670,23 +4943,31 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutNd2NdElem)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd2NdElem))-1 ) = PACK(InData%OutNd2NdElem,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd2NdElem) + DO i2 = LBOUND(InData%OutNd2NdElem,2), UBOUND(InData%OutNd2NdElem,2) + DO i1 = LBOUND(InData%OutNd2NdElem,1), UBOUND(InData%OutNd2NdElem,1) + IntKiBuf(Int_Xferred) = InData%OutNd2NdElem(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UsePitchAct , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchJ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchK - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%torqM))-1 ) = PACK(InData%torqM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%torqM) + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchJ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchK + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchC + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%torqM,2), UBOUND(InData%torqM,2) + DO i1 = LBOUND(InData%torqM,1), UBOUND(InData%torqM,1) + ReKiBuf(Re_Xferred) = InData%torqM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4715,18 +4996,78 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%qp_indx_offset - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldMotionNodeLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_fd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_comp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%qp_indx_offset + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldMotionNodeLoc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_pert + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4746,8 +5087,16 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_Shp_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_Shp_Jac))-1 ) = PACK(InData%QPtw_Shp_Shp_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_Shp_Jac) + DO i4 = LBOUND(InData%QPtw_Shp_Shp_Jac,4), UBOUND(InData%QPtw_Shp_Shp_Jac,4) + DO i3 = LBOUND(InData%QPtw_Shp_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Shp_Jac,3) + DO i2 = LBOUND(InData%QPtw_Shp_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Shp_Jac,2) + DO i1 = LBOUND(InData%QPtw_Shp_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Shp_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4765,8 +5114,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_ShpDer))-1 ) = PACK(InData%QPtw_Shp_ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_ShpDer) + DO i3 = LBOUND(InData%QPtw_Shp_ShpDer,3), UBOUND(InData%QPtw_Shp_ShpDer,3) + DO i2 = LBOUND(InData%QPtw_Shp_ShpDer,2), UBOUND(InData%QPtw_Shp_ShpDer,2) + DO i1 = LBOUND(InData%QPtw_Shp_ShpDer,1), UBOUND(InData%QPtw_Shp_ShpDer,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_ShpDer(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4787,8 +5142,16 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_ShpDer_ShpDer_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_ShpDer_ShpDer_Jac))-1 ) = PACK(InData%QPtw_ShpDer_ShpDer_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_ShpDer_ShpDer_Jac) + DO i4 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) + DO i3 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) + DO i2 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) + DO i1 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4806,8 +5169,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_Jac))-1 ) = PACK(InData%QPtw_Shp_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_Jac) + DO i3 = LBOUND(InData%QPtw_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Jac,3) + DO i2 = LBOUND(InData%QPtw_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Jac,2) + DO i1 = LBOUND(InData%QPtw_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Jac(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4822,8 +5191,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_ShpDer))-1 ) = PACK(InData%QPtw_ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_ShpDer) + DO i2 = LBOUND(InData%QPtw_ShpDer,2), UBOUND(InData%QPtw_ShpDer,2) + DO i1 = LBOUND(InData%QPtw_ShpDer,1), UBOUND(InData%QPtw_ShpDer,1) + DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FEweight) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4838,8 +5211,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FEweight)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%FEweight))-1 ) = PACK(InData%FEweight,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%FEweight) + DO i2 = LBOUND(InData%FEweight,2), UBOUND(InData%FEweight,2) + DO i1 = LBOUND(InData%FEweight,1), UBOUND(InData%FEweight,1) + DbKiBuf(Db_Xferred) = InData%FEweight(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4854,8 +5231,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4867,19 +5248,23 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + 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 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RotStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RelStates , IntKiBuf(1), 1) - 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 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackParam SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4895,12 +5280,6 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4918,21 +5297,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%coef,1) i1_u = UBOUND(OutData%coef,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%coef = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%coef))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%coef) - DEALLOCATE(mask1) - OutData%rhoinf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%coef,1), UBOUND(OutData%coef,1) + OutData%coef(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%rhoinf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuN0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4952,15 +5326,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uuN0)>0) OutData%uuN0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uuN0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uuN0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uuN0,3), UBOUND(OutData%uuN0,3) + DO i2 = LBOUND(OutData%uuN0,2), UBOUND(OutData%uuN0,2) + DO i1 = LBOUND(OutData%uuN0,1), UBOUND(OutData%uuN0,1) + OutData%uuN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif0_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -4981,15 +5354,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Stif0_QP)>0) OutData%Stif0_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Stif0_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Stif0_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Stif0_QP,3), UBOUND(OutData%Stif0_QP,3) + DO i2 = LBOUND(OutData%Stif0_QP,2), UBOUND(OutData%Stif0_QP,2) + DO i1 = LBOUND(OutData%Stif0_QP,1), UBOUND(OutData%Stif0_QP,1) + OutData%Stif0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass0_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -5010,27 +5382,21 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Mass0_QP)>0) OutData%Mass0_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Mass0_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Mass0_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Mass0_QP,3), UBOUND(OutData%Mass0_QP,3) + DO i2 = LBOUND(OutData%Mass0_QP,2), UBOUND(OutData%Mass0_QP,2) + DO i1 = LBOUND(OutData%Mass0_QP,1), UBOUND(OutData%Mass0_QP,1) + OutData%Mass0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%gravity,1) i1_u = UBOUND(OutData%gravity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%gravity = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%gravity))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%gravity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) + OutData%gravity(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! segment_eta not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5044,15 +5410,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%segment_eta)>0) OutData%segment_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%segment_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%segment_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%segment_eta,1), UBOUND(OutData%segment_eta,1) + OutData%segment_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! member_eta not allocated Int_Xferred = Int_Xferred + 1 @@ -5067,92 +5428,61 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%member_eta)>0) OutData%member_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%member_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%member_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%member_eta,1), UBOUND(OutData%member_eta,1) + OutData%member_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%blade_length = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%blade_mass = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%blade_length = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%blade_mass = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%blade_CG,1) i1_u = UBOUND(OutData%blade_CG,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%blade_CG = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%blade_CG))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%blade_CG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%blade_CG,1), UBOUND(OutData%blade_CG,1) + OutData%blade_CG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%blade_IN,1) i1_u = UBOUND(OutData%blade_IN,1) i2_l = LBOUND(OutData%blade_IN,2) i2_u = UBOUND(OutData%blade_IN,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%blade_IN = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%blade_IN))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%blade_IN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%blade_IN,2), UBOUND(OutData%blade_IN,2) + DO i1 = LBOUND(OutData%blade_IN,1), UBOUND(OutData%blade_IN,1) + OutData%blade_IN(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%beta,1) i1_u = UBOUND(OutData%beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%beta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%beta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%beta) - DEALLOCATE(mask1) - OutData%tol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) + OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%tol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%GlbPos,1) i1_u = UBOUND(OutData%GlbPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GlbPos = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbPos))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) + OutData%GlbPos(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbRot,1) i1_u = UBOUND(OutData%GlbRot,1) i2_l = LBOUND(OutData%GlbRot,2) i2_u = UBOUND(OutData%GlbRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GlbRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) + DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) + OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%Glb_crv,1) i1_u = UBOUND(OutData%Glb_crv,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Glb_crv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Glb_crv))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Glb_crv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Glb_crv,1), UBOUND(OutData%Glb_crv,1) + OutData%Glb_crv(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5166,15 +5496,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QPtN)>0) OutData%QPtN = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtN))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) + OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtWeight not allocated Int_Xferred = Int_Xferred + 1 @@ -5189,15 +5514,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QPtWeight)>0) OutData%QPtWeight = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtWeight))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtWeight) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QPtWeight,1), UBOUND(OutData%QPtWeight,1) + OutData%QPtWeight(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Shp not allocated Int_Xferred = Int_Xferred + 1 @@ -5215,15 +5535,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Shp)>0) OutData%Shp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Shp))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Shp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Shp,2), UBOUND(OutData%Shp,2) + DO i1 = LBOUND(OutData%Shp,1), UBOUND(OutData%Shp,1) + OutData%Shp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5241,15 +5558,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ShpDer)>0) OutData%ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ShpDer))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ShpDer) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ShpDer,2), UBOUND(OutData%ShpDer,2) + DO i1 = LBOUND(OutData%ShpDer,1), UBOUND(OutData%ShpDer,1) + OutData%ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian not allocated Int_Xferred = Int_Xferred + 1 @@ -5267,15 +5581,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jacobian)>0) OutData%Jacobian = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Jacobian))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Jacobian) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jacobian,2), UBOUND(OutData%Jacobian,2) + DO i1 = LBOUND(OutData%Jacobian,1), UBOUND(OutData%Jacobian,1) + OutData%Jacobian(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uu0 not allocated Int_Xferred = Int_Xferred + 1 @@ -5296,15 +5607,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uu0)>0) OutData%uu0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uu0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uu0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uu0,3), UBOUND(OutData%uu0,3) + DO i2 = LBOUND(OutData%uu0,2), UBOUND(OutData%uu0,2) + DO i1 = LBOUND(OutData%uu0,1), UBOUND(OutData%uu0,1) + OutData%uu0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rrN0 not allocated Int_Xferred = Int_Xferred + 1 @@ -5325,15 +5635,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rrN0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rrN0)>0) OutData%rrN0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rrN0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rrN0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rrN0,3), UBOUND(OutData%rrN0,3) + DO i2 = LBOUND(OutData%rrN0,2), UBOUND(OutData%rrN0,2) + DO i1 = LBOUND(OutData%rrN0,1), UBOUND(OutData%rrN0,1) + OutData%rrN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E10 not allocated Int_Xferred = Int_Xferred + 1 @@ -5354,15 +5663,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%E10)>0) OutData%E10 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%E10))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%E10) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%E10,3), UBOUND(OutData%E10,3) + DO i2 = LBOUND(OutData%E10,2), UBOUND(OutData%E10,2) + DO i1 = LBOUND(OutData%E10,1), UBOUND(OutData%E10,1) + OutData%E10(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SP_Coef not allocated Int_Xferred = Int_Xferred + 1 @@ -5383,18 +5691,17 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SP_Coef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SP_Coef)>0) OutData%SP_Coef = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SP_Coef))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SP_Coef) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%SP_Coef,3), UBOUND(OutData%SP_Coef,3) + DO i2 = LBOUND(OutData%SP_Coef,2), UBOUND(OutData%SP_Coef,2) + DO i1 = LBOUND(OutData%SP_Coef,1), UBOUND(OutData%SP_Coef,1) + OutData%SP_Coef(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - OutData%nodes_per_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%nodes_per_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5411,48 +5718,45 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%node_elem_idx)>0) OutData%node_elem_idx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%node_elem_idx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%node_elem_idx) - DEALLOCATE(mask2) - END IF - OutData%refine = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_node = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rot_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%elem_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%node_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nqp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%analysis_type = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%damp_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ld_retries = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%niter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutInputs = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%node_elem_idx,2), UBOUND(OutData%node_elem_idx,2) + DO i1 = LBOUND(OutData%node_elem_idx,1), UBOUND(OutData%node_elem_idx,1) + OutData%node_elem_idx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%refine = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_node = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rot_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%elem_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%node_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nqp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%analysis_type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%damp_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ld_retries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%niter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%quadrature = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_fact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutInputs = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutInputs) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5509,19 +5813,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NNodeOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NNodeOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutNd,1) i1_u = UBOUND(OutData%OutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) + OutData%OutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5535,15 +5834,28 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%NdIndx,1), UBOUND(OutData%NdIndx,1) + OutData%NdIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndxInverse not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NdIndxInverse)) DEALLOCATE(OutData%NdIndxInverse) + ALLOCATE(OutData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%NdIndx)>0) OutData%NdIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NdIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NdIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NdIndxInverse,1), UBOUND(OutData%NdIndxInverse,1) + OutData%NdIndxInverse(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem not allocated Int_Xferred = Int_Xferred + 1 @@ -5552,50 +5864,114 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) - ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutNd2NdElem)>0) OutData%OutNd2NdElem = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd2NdElem))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd2NdElem) - DEALLOCATE(mask2) - END IF - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%pitchJ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%pitchK = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%pitchC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%torqM,1) - i1_u = UBOUND(OutData%torqM,1) - i2_l = LBOUND(OutData%torqM,2) - i2_u = UBOUND(OutData%torqM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) + ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OutNd2NdElem,2), UBOUND(OutData%OutNd2NdElem,2) + DO i1 = LBOUND(OutData%OutNd2NdElem,1), UBOUND(OutData%OutNd2NdElem,1) + OutData%OutNd2NdElem(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) + Int_Xferred = Int_Xferred + 1 + OutData%pitchJ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchK = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%torqM,1) + i1_u = UBOUND(OutData%torqM,1) + i2_l = LBOUND(OutData%torqM,2) + i2_u = UBOUND(OutData%torqM,2) + DO i2 = LBOUND(OutData%torqM,2), UBOUND(OutData%torqM,2) + DO i1 = LBOUND(OutData%torqM,1), UBOUND(OutData%torqM,1) + OutData%torqM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_Unpackqpparam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%qp_indx_offset = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldMotionNodeLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - OutData%torqM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%torqM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%torqM) - DEALLOCATE(mask2) + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5629,25 +6005,33 @@ SUBROUTINE BD_UnPackParam( 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 BD_Unpackqpparam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%qp_indx_offset = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BldMotionNodeLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_pert = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5670,15 +6054,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_Shp_Jac)>0) OutData%QPtw_Shp_Shp_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_Shp_Jac))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_Shp_Jac) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%QPtw_Shp_Shp_Jac,4), UBOUND(OutData%QPtw_Shp_Shp_Jac,4) + DO i3 = LBOUND(OutData%QPtw_Shp_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Shp_Jac,3) + DO i2 = LBOUND(OutData%QPtw_Shp_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Shp_Jac,2) + DO i1 = LBOUND(OutData%QPtw_Shp_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Shp_Jac,1) + OutData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5699,15 +6084,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_ShpDer)>0) OutData%QPtw_Shp_ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_ShpDer))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_ShpDer) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%QPtw_Shp_ShpDer,3), UBOUND(OutData%QPtw_Shp_ShpDer,3) + DO i2 = LBOUND(OutData%QPtw_Shp_ShpDer,2), UBOUND(OutData%QPtw_Shp_ShpDer,2) + DO i1 = LBOUND(OutData%QPtw_Shp_ShpDer,1), UBOUND(OutData%QPtw_Shp_ShpDer,1) + OutData%QPtw_Shp_ShpDer(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer_ShpDer_Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -5731,15 +6115,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%QPtw_ShpDer_ShpDer_Jac)>0) OutData%QPtw_ShpDer_ShpDer_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_ShpDer_ShpDer_Jac))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_ShpDer_ShpDer_Jac) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4) + DO i3 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3) + DO i2 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2) + DO i1 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1) + OutData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -5760,15 +6145,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_Jac)>0) OutData%QPtw_Shp_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_Jac))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_Jac) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%QPtw_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Jac,3) + DO i2 = LBOUND(OutData%QPtw_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Jac,2) + DO i1 = LBOUND(OutData%QPtw_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Jac,1) + OutData%QPtw_Shp_Jac(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5786,15 +6170,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QPtw_ShpDer)>0) OutData%QPtw_ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_ShpDer))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_ShpDer) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QPtw_ShpDer,2), UBOUND(OutData%QPtw_ShpDer,2) + DO i1 = LBOUND(OutData%QPtw_ShpDer,1), UBOUND(OutData%QPtw_ShpDer,1) + OutData%QPtw_ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FEweight not allocated Int_Xferred = Int_Xferred + 1 @@ -5812,15 +6193,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FEweight)>0) OutData%FEweight = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%FEweight))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%FEweight) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FEweight,2), UBOUND(OutData%FEweight,2) + DO i1 = LBOUND(OutData%FEweight,1), UBOUND(OutData%FEweight,1) + OutData%FEweight(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -5838,15 +6216,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -5861,35 +6236,25 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%dx,1) i1_u = UBOUND(OutData%dx,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Jac_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackParam SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -6193,12 +6558,6 @@ SUBROUTINE BD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInput' @@ -6587,10 +6946,10 @@ SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RootMxr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RootMyr - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RootMxr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RootMyr + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6601,8 +6960,10 @@ SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BD_PackOutput @@ -6619,12 +6980,6 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6719,10 +7074,10 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RootMxr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RootMyr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RootMxr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RootMyr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6736,15 +7091,10 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BD_UnPackOutput @@ -7635,8 +7985,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uuu)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uuu))-1 ) = PACK(InData%uuu,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uuu) + DO i3 = LBOUND(InData%uuu,3), UBOUND(InData%uuu,3) + DO i2 = LBOUND(InData%uuu,2), UBOUND(InData%uuu,2) + DO i1 = LBOUND(InData%uuu,1), UBOUND(InData%uuu,1) + DbKiBuf(Db_Xferred) = InData%uuu(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%uup) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7654,8 +8010,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uup)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uup))-1 ) = PACK(InData%uup,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uup) + DO i3 = LBOUND(InData%uup,3), UBOUND(InData%uup,3) + DO i2 = LBOUND(InData%uup,2), UBOUND(InData%uup,2) + DO i1 = LBOUND(InData%uup,1), UBOUND(InData%uup,1) + DbKiBuf(Db_Xferred) = InData%uup(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vvv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7673,8 +8035,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vvv)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%vvv))-1 ) = PACK(InData%vvv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%vvv) + DO i3 = LBOUND(InData%vvv,3), UBOUND(InData%vvv,3) + DO i2 = LBOUND(InData%vvv,2), UBOUND(InData%vvv,2) + DO i1 = LBOUND(InData%vvv,1), UBOUND(InData%vvv,1) + DbKiBuf(Db_Xferred) = InData%vvv(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vvp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7692,8 +8060,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vvp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%vvp))-1 ) = PACK(InData%vvp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%vvp) + DO i3 = LBOUND(InData%vvp,3), UBOUND(InData%vvp,3) + DO i2 = LBOUND(InData%vvp,2), UBOUND(InData%vvp,2) + DO i1 = LBOUND(InData%vvp,1), UBOUND(InData%vvp,1) + DbKiBuf(Db_Xferred) = InData%vvp(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%aaa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7711,8 +8085,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%aaa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%aaa))-1 ) = PACK(InData%aaa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%aaa) + DO i3 = LBOUND(InData%aaa,3), UBOUND(InData%aaa,3) + DO i2 = LBOUND(InData%aaa,2), UBOUND(InData%aaa,2) + DO i1 = LBOUND(InData%aaa,1), UBOUND(InData%aaa,1) + DbKiBuf(Db_Xferred) = InData%aaa(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RR0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7733,8 +8113,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RR0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RR0))-1 ) = PACK(InData%RR0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RR0) + DO i4 = LBOUND(InData%RR0,4), UBOUND(InData%RR0,4) + DO i3 = LBOUND(InData%RR0,3), UBOUND(InData%RR0,3) + DO i2 = LBOUND(InData%RR0,2), UBOUND(InData%RR0,2) + DO i1 = LBOUND(InData%RR0,1), UBOUND(InData%RR0,1) + DbKiBuf(Db_Xferred) = InData%RR0(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%kappa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7752,8 +8140,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kappa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kappa))-1 ) = PACK(InData%kappa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kappa) + DO i3 = LBOUND(InData%kappa,3), UBOUND(InData%kappa,3) + DO i2 = LBOUND(InData%kappa,2), UBOUND(InData%kappa,2) + DO i1 = LBOUND(InData%kappa,1), UBOUND(InData%kappa,1) + DbKiBuf(Db_Xferred) = InData%kappa(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%E1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7771,8 +8165,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%E1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%E1))-1 ) = PACK(InData%E1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%E1) + DO i3 = LBOUND(InData%E1,3), UBOUND(InData%E1,3) + DO i2 = LBOUND(InData%E1,2), UBOUND(InData%E1,2) + DO i1 = LBOUND(InData%E1,1), UBOUND(InData%E1,1) + DbKiBuf(Db_Xferred) = InData%E1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7793,8 +8193,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stif)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Stif))-1 ) = PACK(InData%Stif,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Stif) + DO i4 = LBOUND(InData%Stif,4), UBOUND(InData%Stif,4) + DO i3 = LBOUND(InData%Stif,3), UBOUND(InData%Stif,3) + DO i2 = LBOUND(InData%Stif,2), UBOUND(InData%Stif,2) + DO i1 = LBOUND(InData%Stif,1), UBOUND(InData%Stif,1) + DbKiBuf(Db_Xferred) = InData%Stif(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7812,8 +8220,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fb)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fb))-1 ) = PACK(InData%Fb,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fb) + DO i3 = LBOUND(InData%Fb,3), UBOUND(InData%Fb,3) + DO i2 = LBOUND(InData%Fb,2), UBOUND(InData%Fb,2) + DO i1 = LBOUND(InData%Fb,1), UBOUND(InData%Fb,1) + DbKiBuf(Db_Xferred) = InData%Fb(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7831,8 +8245,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fc))-1 ) = PACK(InData%Fc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fc) + DO i3 = LBOUND(InData%Fc,3), UBOUND(InData%Fc,3) + DO i2 = LBOUND(InData%Fc,2), UBOUND(InData%Fc,2) + DO i1 = LBOUND(InData%Fc,1), UBOUND(InData%Fc,1) + DbKiBuf(Db_Xferred) = InData%Fc(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7850,8 +8270,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fd))-1 ) = PACK(InData%Fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fd) + DO i3 = LBOUND(InData%Fd,3), UBOUND(InData%Fd,3) + DO i2 = LBOUND(InData%Fd,2), UBOUND(InData%Fd,2) + DO i1 = LBOUND(InData%Fd,1), UBOUND(InData%Fd,1) + DbKiBuf(Db_Xferred) = InData%Fd(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7869,8 +8295,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fg)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fg))-1 ) = PACK(InData%Fg,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fg) + DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) + DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) + DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) + DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7888,8 +8320,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fi))-1 ) = PACK(InData%Fi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fi) + DO i3 = LBOUND(InData%Fi,3), UBOUND(InData%Fi,3) + DO i2 = LBOUND(InData%Fi,2), UBOUND(InData%Fi,2) + DO i1 = LBOUND(InData%Fi,1), UBOUND(InData%Fi,1) + DbKiBuf(Db_Xferred) = InData%Fi(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ftemp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7907,8 +8345,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ftemp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ftemp))-1 ) = PACK(InData%Ftemp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ftemp) + DO i3 = LBOUND(InData%Ftemp,3), UBOUND(InData%Ftemp,3) + DO i2 = LBOUND(InData%Ftemp,2), UBOUND(InData%Ftemp,2) + DO i1 = LBOUND(InData%Ftemp,1), UBOUND(InData%Ftemp,1) + DbKiBuf(Db_Xferred) = InData%Ftemp(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RR0mEta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7926,8 +8370,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RR0mEta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RR0mEta))-1 ) = PACK(InData%RR0mEta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RR0mEta) + DO i3 = LBOUND(InData%RR0mEta,3), UBOUND(InData%RR0mEta,3) + DO i2 = LBOUND(InData%RR0mEta,2), UBOUND(InData%RR0mEta,2) + DO i1 = LBOUND(InData%RR0mEta,1), UBOUND(InData%RR0mEta,1) + DbKiBuf(Db_Xferred) = InData%RR0mEta(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rho) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7948,8 +8398,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rho)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rho))-1 ) = PACK(InData%rho,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rho) + DO i4 = LBOUND(InData%rho,4), UBOUND(InData%rho,4) + DO i3 = LBOUND(InData%rho,3), UBOUND(InData%rho,3) + DO i2 = LBOUND(InData%rho,2), UBOUND(InData%rho,2) + DO i1 = LBOUND(InData%rho,1), UBOUND(InData%rho,1) + DbKiBuf(Db_Xferred) = InData%rho(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%betaC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7970,8 +8428,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%betaC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%betaC))-1 ) = PACK(InData%betaC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%betaC) + DO i4 = LBOUND(InData%betaC,4), UBOUND(InData%betaC,4) + DO i3 = LBOUND(InData%betaC,3), UBOUND(InData%betaC,3) + DO i2 = LBOUND(InData%betaC,2), UBOUND(InData%betaC,2) + DO i1 = LBOUND(InData%betaC,1), UBOUND(InData%betaC,1) + DbKiBuf(Db_Xferred) = InData%betaC(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Gi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7992,8 +8458,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Gi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Gi))-1 ) = PACK(InData%Gi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Gi) + DO i4 = LBOUND(InData%Gi,4), UBOUND(InData%Gi,4) + DO i3 = LBOUND(InData%Gi,3), UBOUND(InData%Gi,3) + DO i2 = LBOUND(InData%Gi,2), UBOUND(InData%Gi,2) + DO i1 = LBOUND(InData%Gi,1), UBOUND(InData%Gi,1) + DbKiBuf(Db_Xferred) = InData%Gi(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ki) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8014,8 +8488,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ki)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ki))-1 ) = PACK(InData%Ki,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ki) + DO i4 = LBOUND(InData%Ki,4), UBOUND(InData%Ki,4) + DO i3 = LBOUND(InData%Ki,3), UBOUND(InData%Ki,3) + DO i2 = LBOUND(InData%Ki,2), UBOUND(InData%Ki,2) + DO i1 = LBOUND(InData%Ki,1), UBOUND(InData%Ki,1) + DbKiBuf(Db_Xferred) = InData%Ki(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Mi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8036,8 +8518,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Mi))-1 ) = PACK(InData%Mi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Mi) + DO i4 = LBOUND(InData%Mi,4), UBOUND(InData%Mi,4) + DO i3 = LBOUND(InData%Mi,3), UBOUND(InData%Mi,3) + DO i2 = LBOUND(InData%Mi,2), UBOUND(InData%Mi,2) + DO i1 = LBOUND(InData%Mi,1), UBOUND(InData%Mi,1) + DbKiBuf(Db_Xferred) = InData%Mi(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Oe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8058,8 +8548,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Oe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Oe))-1 ) = PACK(InData%Oe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Oe) + DO i4 = LBOUND(InData%Oe,4), UBOUND(InData%Oe,4) + DO i3 = LBOUND(InData%Oe,3), UBOUND(InData%Oe,3) + DO i2 = LBOUND(InData%Oe,2), UBOUND(InData%Oe,2) + DO i1 = LBOUND(InData%Oe,1), UBOUND(InData%Oe,1) + DbKiBuf(Db_Xferred) = InData%Oe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Pe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8080,8 +8578,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Pe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Pe))-1 ) = PACK(InData%Pe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Pe) + DO i4 = LBOUND(InData%Pe,4), UBOUND(InData%Pe,4) + DO i3 = LBOUND(InData%Pe,3), UBOUND(InData%Pe,3) + DO i2 = LBOUND(InData%Pe,2), UBOUND(InData%Pe,2) + DO i1 = LBOUND(InData%Pe,1), UBOUND(InData%Pe,1) + DbKiBuf(Db_Xferred) = InData%Pe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Qe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8102,8 +8608,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Qe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Qe))-1 ) = PACK(InData%Qe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Qe) + DO i4 = LBOUND(InData%Qe,4), UBOUND(InData%Qe,4) + DO i3 = LBOUND(InData%Qe,3), UBOUND(InData%Qe,3) + DO i2 = LBOUND(InData%Qe,2), UBOUND(InData%Qe,2) + DO i1 = LBOUND(InData%Qe,1), UBOUND(InData%Qe,1) + DbKiBuf(Db_Xferred) = InData%Qe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Gd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8124,8 +8638,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Gd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Gd))-1 ) = PACK(InData%Gd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Gd) + DO i4 = LBOUND(InData%Gd,4), UBOUND(InData%Gd,4) + DO i3 = LBOUND(InData%Gd,3), UBOUND(InData%Gd,3) + DO i2 = LBOUND(InData%Gd,2), UBOUND(InData%Gd,2) + DO i1 = LBOUND(InData%Gd,1), UBOUND(InData%Gd,1) + DbKiBuf(Db_Xferred) = InData%Gd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Od) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8146,8 +8668,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Od)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Od))-1 ) = PACK(InData%Od,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Od) + DO i4 = LBOUND(InData%Od,4), UBOUND(InData%Od,4) + DO i3 = LBOUND(InData%Od,3), UBOUND(InData%Od,3) + DO i2 = LBOUND(InData%Od,2), UBOUND(InData%Od,2) + DO i1 = LBOUND(InData%Od,1), UBOUND(InData%Od,1) + DbKiBuf(Db_Xferred) = InData%Od(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Pd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8168,8 +8698,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Pd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Pd))-1 ) = PACK(InData%Pd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Pd) + DO i4 = LBOUND(InData%Pd,4), UBOUND(InData%Pd,4) + DO i3 = LBOUND(InData%Pd,3), UBOUND(InData%Pd,3) + DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) + DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) + DbKiBuf(Db_Xferred) = InData%Pd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Qd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8190,8 +8728,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Qd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Qd))-1 ) = PACK(InData%Qd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Qd) + DO i4 = LBOUND(InData%Qd,4), UBOUND(InData%Qd,4) + DO i3 = LBOUND(InData%Qd,3), UBOUND(InData%Qd,3) + DO i2 = LBOUND(InData%Qd,2), UBOUND(InData%Qd,2) + DO i1 = LBOUND(InData%Qd,1), UBOUND(InData%Qd,1) + DbKiBuf(Db_Xferred) = InData%Qd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Sd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8212,8 +8758,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Sd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Sd))-1 ) = PACK(InData%Sd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Sd) + DO i4 = LBOUND(InData%Sd,4), UBOUND(InData%Sd,4) + DO i3 = LBOUND(InData%Sd,3), UBOUND(InData%Sd,3) + DO i2 = LBOUND(InData%Sd,2), UBOUND(InData%Sd,2) + DO i1 = LBOUND(InData%Sd,1), UBOUND(InData%Sd,1) + DbKiBuf(Db_Xferred) = InData%Sd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Xd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8234,8 +8788,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Xd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Xd))-1 ) = PACK(InData%Xd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Xd) + DO i4 = LBOUND(InData%Xd,4), UBOUND(InData%Xd,4) + DO i3 = LBOUND(InData%Xd,3), UBOUND(InData%Xd,3) + DO i2 = LBOUND(InData%Xd,2), UBOUND(InData%Xd,2) + DO i1 = LBOUND(InData%Xd,1), UBOUND(InData%Xd,1) + DbKiBuf(Db_Xferred) = InData%Xd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Yd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8256,8 +8818,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Yd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Yd))-1 ) = PACK(InData%Yd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Yd) + DO i4 = LBOUND(InData%Yd,4), UBOUND(InData%Yd,4) + DO i3 = LBOUND(InData%Yd,3), UBOUND(InData%Yd,3) + DO i2 = LBOUND(InData%Yd,2), UBOUND(InData%Yd,2) + DO i1 = LBOUND(InData%Yd,1), UBOUND(InData%Yd,1) + DbKiBuf(Db_Xferred) = InData%Yd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF END SUBROUTINE BD_PackEqMotionQP @@ -8274,12 +8844,6 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -8316,15 +8880,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uuu)>0) OutData%uuu = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uuu))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uuu) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uuu,3), UBOUND(OutData%uuu,3) + DO i2 = LBOUND(OutData%uuu,2), UBOUND(OutData%uuu,2) + DO i1 = LBOUND(OutData%uuu,1), UBOUND(OutData%uuu,1) + OutData%uuu(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uup not allocated Int_Xferred = Int_Xferred + 1 @@ -8345,15 +8908,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uup)>0) OutData%uup = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uup))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uup) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uup,3), UBOUND(OutData%uup,3) + DO i2 = LBOUND(OutData%uup,2), UBOUND(OutData%uup,2) + DO i1 = LBOUND(OutData%uup,1), UBOUND(OutData%uup,1) + OutData%uup(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvv not allocated Int_Xferred = Int_Xferred + 1 @@ -8374,15 +8936,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vvv)>0) OutData%vvv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%vvv))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%vvv) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vvv,3), UBOUND(OutData%vvv,3) + DO i2 = LBOUND(OutData%vvv,2), UBOUND(OutData%vvv,2) + DO i1 = LBOUND(OutData%vvv,1), UBOUND(OutData%vvv,1) + OutData%vvv(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvp not allocated Int_Xferred = Int_Xferred + 1 @@ -8403,15 +8964,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vvp)>0) OutData%vvp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%vvp))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%vvp) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vvp,3), UBOUND(OutData%vvp,3) + DO i2 = LBOUND(OutData%vvp,2), UBOUND(OutData%vvp,2) + DO i1 = LBOUND(OutData%vvp,1), UBOUND(OutData%vvp,1) + OutData%vvp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! aaa not allocated Int_Xferred = Int_Xferred + 1 @@ -8432,15 +8992,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%aaa)>0) OutData%aaa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%aaa))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%aaa) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%aaa,3), UBOUND(OutData%aaa,3) + DO i2 = LBOUND(OutData%aaa,2), UBOUND(OutData%aaa,2) + DO i1 = LBOUND(OutData%aaa,1), UBOUND(OutData%aaa,1) + OutData%aaa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0 not allocated Int_Xferred = Int_Xferred + 1 @@ -8464,15 +9023,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%RR0)>0) OutData%RR0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RR0))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RR0) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%RR0,4), UBOUND(OutData%RR0,4) + DO i3 = LBOUND(OutData%RR0,3), UBOUND(OutData%RR0,3) + DO i2 = LBOUND(OutData%RR0,2), UBOUND(OutData%RR0,2) + DO i1 = LBOUND(OutData%RR0,1), UBOUND(OutData%RR0,1) + OutData%RR0(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kappa not allocated Int_Xferred = Int_Xferred + 1 @@ -8493,15 +9053,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%kappa)>0) OutData%kappa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kappa))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kappa) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%kappa,3), UBOUND(OutData%kappa,3) + DO i2 = LBOUND(OutData%kappa,2), UBOUND(OutData%kappa,2) + DO i1 = LBOUND(OutData%kappa,1), UBOUND(OutData%kappa,1) + OutData%kappa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E1 not allocated Int_Xferred = Int_Xferred + 1 @@ -8522,15 +9081,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%E1)>0) OutData%E1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%E1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%E1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%E1,3), UBOUND(OutData%E1,3) + DO i2 = LBOUND(OutData%E1,2), UBOUND(OutData%E1,2) + DO i1 = LBOUND(OutData%E1,1), UBOUND(OutData%E1,1) + OutData%E1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif not allocated Int_Xferred = Int_Xferred + 1 @@ -8554,15 +9112,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Stif)>0) OutData%Stif = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Stif))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Stif) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Stif,4), UBOUND(OutData%Stif,4) + DO i3 = LBOUND(OutData%Stif,3), UBOUND(OutData%Stif,3) + DO i2 = LBOUND(OutData%Stif,2), UBOUND(OutData%Stif,2) + DO i1 = LBOUND(OutData%Stif,1), UBOUND(OutData%Stif,1) + OutData%Stif(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fb not allocated Int_Xferred = Int_Xferred + 1 @@ -8583,15 +9142,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fb)>0) OutData%Fb = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fb))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fb) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fb,3), UBOUND(OutData%Fb,3) + DO i2 = LBOUND(OutData%Fb,2), UBOUND(OutData%Fb,2) + DO i1 = LBOUND(OutData%Fb,1), UBOUND(OutData%Fb,1) + OutData%Fb(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fc not allocated Int_Xferred = Int_Xferred + 1 @@ -8612,15 +9170,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fc)>0) OutData%Fc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fc))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fc,3), UBOUND(OutData%Fc,3) + DO i2 = LBOUND(OutData%Fc,2), UBOUND(OutData%Fc,2) + DO i1 = LBOUND(OutData%Fc,1), UBOUND(OutData%Fc,1) + OutData%Fc(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fd not allocated Int_Xferred = Int_Xferred + 1 @@ -8641,15 +9198,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fd)>0) OutData%Fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fd))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fd) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fd,3), UBOUND(OutData%Fd,3) + DO i2 = LBOUND(OutData%Fd,2), UBOUND(OutData%Fd,2) + DO i1 = LBOUND(OutData%Fd,1), UBOUND(OutData%Fd,1) + OutData%Fd(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated Int_Xferred = Int_Xferred + 1 @@ -8670,15 +9226,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fg)>0) OutData%Fg = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fg))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fg) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) + DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) + DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) + OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fi not allocated Int_Xferred = Int_Xferred + 1 @@ -8699,15 +9254,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fi)>0) OutData%Fi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fi))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fi) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fi,3), UBOUND(OutData%Fi,3) + DO i2 = LBOUND(OutData%Fi,2), UBOUND(OutData%Fi,2) + DO i1 = LBOUND(OutData%Fi,1), UBOUND(OutData%Fi,1) + OutData%Fi(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ftemp not allocated Int_Xferred = Int_Xferred + 1 @@ -8728,15 +9282,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Ftemp)>0) OutData%Ftemp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ftemp))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Ftemp) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Ftemp,3), UBOUND(OutData%Ftemp,3) + DO i2 = LBOUND(OutData%Ftemp,2), UBOUND(OutData%Ftemp,2) + DO i1 = LBOUND(OutData%Ftemp,1), UBOUND(OutData%Ftemp,1) + OutData%Ftemp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0mEta not allocated Int_Xferred = Int_Xferred + 1 @@ -8757,15 +9310,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RR0mEta)>0) OutData%RR0mEta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RR0mEta))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RR0mEta) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RR0mEta,3), UBOUND(OutData%RR0mEta,3) + DO i2 = LBOUND(OutData%RR0mEta,2), UBOUND(OutData%RR0mEta,2) + DO i1 = LBOUND(OutData%RR0mEta,1), UBOUND(OutData%RR0mEta,1) + OutData%RR0mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rho not allocated Int_Xferred = Int_Xferred + 1 @@ -8789,15 +9341,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%rho)>0) OutData%rho = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rho))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rho) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%rho,4), UBOUND(OutData%rho,4) + DO i3 = LBOUND(OutData%rho,3), UBOUND(OutData%rho,3) + DO i2 = LBOUND(OutData%rho,2), UBOUND(OutData%rho,2) + DO i1 = LBOUND(OutData%rho,1), UBOUND(OutData%rho,1) + OutData%rho(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! betaC not allocated Int_Xferred = Int_Xferred + 1 @@ -8821,15 +9374,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%betaC)>0) OutData%betaC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%betaC))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%betaC) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%betaC,4), UBOUND(OutData%betaC,4) + DO i3 = LBOUND(OutData%betaC,3), UBOUND(OutData%betaC,3) + DO i2 = LBOUND(OutData%betaC,2), UBOUND(OutData%betaC,2) + DO i1 = LBOUND(OutData%betaC,1), UBOUND(OutData%betaC,1) + OutData%betaC(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gi not allocated Int_Xferred = Int_Xferred + 1 @@ -8853,15 +9407,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Gi)>0) OutData%Gi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Gi))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Gi) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Gi,4), UBOUND(OutData%Gi,4) + DO i3 = LBOUND(OutData%Gi,3), UBOUND(OutData%Gi,3) + DO i2 = LBOUND(OutData%Gi,2), UBOUND(OutData%Gi,2) + DO i1 = LBOUND(OutData%Gi,1), UBOUND(OutData%Gi,1) + OutData%Gi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ki not allocated Int_Xferred = Int_Xferred + 1 @@ -8885,15 +9440,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Ki)>0) OutData%Ki = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ki))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Ki) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Ki,4), UBOUND(OutData%Ki,4) + DO i3 = LBOUND(OutData%Ki,3), UBOUND(OutData%Ki,3) + DO i2 = LBOUND(OutData%Ki,2), UBOUND(OutData%Ki,2) + DO i1 = LBOUND(OutData%Ki,1), UBOUND(OutData%Ki,1) + OutData%Ki(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mi not allocated Int_Xferred = Int_Xferred + 1 @@ -8917,15 +9473,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Mi)>0) OutData%Mi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Mi))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Mi) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Mi,4), UBOUND(OutData%Mi,4) + DO i3 = LBOUND(OutData%Mi,3), UBOUND(OutData%Mi,3) + DO i2 = LBOUND(OutData%Mi,2), UBOUND(OutData%Mi,2) + DO i1 = LBOUND(OutData%Mi,1), UBOUND(OutData%Mi,1) + OutData%Mi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Oe not allocated Int_Xferred = Int_Xferred + 1 @@ -8949,15 +9506,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Oe)>0) OutData%Oe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Oe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Oe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Oe,4), UBOUND(OutData%Oe,4) + DO i3 = LBOUND(OutData%Oe,3), UBOUND(OutData%Oe,3) + DO i2 = LBOUND(OutData%Oe,2), UBOUND(OutData%Oe,2) + DO i1 = LBOUND(OutData%Oe,1), UBOUND(OutData%Oe,1) + OutData%Oe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pe not allocated Int_Xferred = Int_Xferred + 1 @@ -8981,15 +9539,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Pe)>0) OutData%Pe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Pe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Pe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Pe,4), UBOUND(OutData%Pe,4) + DO i3 = LBOUND(OutData%Pe,3), UBOUND(OutData%Pe,3) + DO i2 = LBOUND(OutData%Pe,2), UBOUND(OutData%Pe,2) + DO i1 = LBOUND(OutData%Pe,1), UBOUND(OutData%Pe,1) + OutData%Pe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qe not allocated Int_Xferred = Int_Xferred + 1 @@ -9013,15 +9572,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Qe)>0) OutData%Qe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Qe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Qe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Qe,4), UBOUND(OutData%Qe,4) + DO i3 = LBOUND(OutData%Qe,3), UBOUND(OutData%Qe,3) + DO i2 = LBOUND(OutData%Qe,2), UBOUND(OutData%Qe,2) + DO i1 = LBOUND(OutData%Qe,1), UBOUND(OutData%Qe,1) + OutData%Qe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gd not allocated Int_Xferred = Int_Xferred + 1 @@ -9045,15 +9605,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Gd)>0) OutData%Gd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Gd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Gd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Gd,4), UBOUND(OutData%Gd,4) + DO i3 = LBOUND(OutData%Gd,3), UBOUND(OutData%Gd,3) + DO i2 = LBOUND(OutData%Gd,2), UBOUND(OutData%Gd,2) + DO i1 = LBOUND(OutData%Gd,1), UBOUND(OutData%Gd,1) + OutData%Gd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Od not allocated Int_Xferred = Int_Xferred + 1 @@ -9077,15 +9638,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Od)>0) OutData%Od = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Od))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Od) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Od,4), UBOUND(OutData%Od,4) + DO i3 = LBOUND(OutData%Od,3), UBOUND(OutData%Od,3) + DO i2 = LBOUND(OutData%Od,2), UBOUND(OutData%Od,2) + DO i1 = LBOUND(OutData%Od,1), UBOUND(OutData%Od,1) + OutData%Od(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated Int_Xferred = Int_Xferred + 1 @@ -9109,15 +9671,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Pd)>0) OutData%Pd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Pd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Pd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Pd,4), UBOUND(OutData%Pd,4) + DO i3 = LBOUND(OutData%Pd,3), UBOUND(OutData%Pd,3) + DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) + DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) + OutData%Pd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qd not allocated Int_Xferred = Int_Xferred + 1 @@ -9141,15 +9704,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Qd)>0) OutData%Qd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Qd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Qd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Qd,4), UBOUND(OutData%Qd,4) + DO i3 = LBOUND(OutData%Qd,3), UBOUND(OutData%Qd,3) + DO i2 = LBOUND(OutData%Qd,2), UBOUND(OutData%Qd,2) + DO i1 = LBOUND(OutData%Qd,1), UBOUND(OutData%Qd,1) + OutData%Qd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Sd not allocated Int_Xferred = Int_Xferred + 1 @@ -9173,15 +9737,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Sd)>0) OutData%Sd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Sd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Sd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Sd,4), UBOUND(OutData%Sd,4) + DO i3 = LBOUND(OutData%Sd,3), UBOUND(OutData%Sd,3) + DO i2 = LBOUND(OutData%Sd,2), UBOUND(OutData%Sd,2) + DO i1 = LBOUND(OutData%Sd,1), UBOUND(OutData%Sd,1) + OutData%Sd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Xd not allocated Int_Xferred = Int_Xferred + 1 @@ -9205,15 +9770,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Xd)>0) OutData%Xd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Xd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Xd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Xd,4), UBOUND(OutData%Xd,4) + DO i3 = LBOUND(OutData%Xd,3), UBOUND(OutData%Xd,3) + DO i2 = LBOUND(OutData%Xd,2), UBOUND(OutData%Xd,2) + DO i1 = LBOUND(OutData%Xd,1), UBOUND(OutData%Xd,1) + OutData%Xd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Yd not allocated Int_Xferred = Int_Xferred + 1 @@ -9237,15 +9803,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Yd)>0) OutData%Yd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Yd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Yd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Yd,4), UBOUND(OutData%Yd,4) + DO i3 = LBOUND(OutData%Yd,3), UBOUND(OutData%Yd,3) + DO i2 = LBOUND(OutData%Yd,2), UBOUND(OutData%Yd,2) + DO i1 = LBOUND(OutData%Yd,1), UBOUND(OutData%Yd,1) + OutData%Yd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF END SUBROUTINE BD_UnPackEqMotionQP @@ -10298,8 +10865,8 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Un_Sum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Un_Sum + Int_Xferred = Int_Xferred + 1 CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10341,8 +10908,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lin_A)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%lin_A))-1 ) = PACK(InData%lin_A,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%lin_A) + DO i2 = LBOUND(InData%lin_A,2), UBOUND(InData%lin_A,2) + DO i1 = LBOUND(InData%lin_A,1), UBOUND(InData%lin_A,1) + DbKiBuf(Db_Xferred) = InData%lin_A(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%lin_C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10357,8 +10928,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lin_C)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%lin_C))-1 ) = PACK(InData%lin_C,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%lin_C) + DO i2 = LBOUND(InData%lin_C,2), UBOUND(InData%lin_C,2) + DO i1 = LBOUND(InData%lin_C,1), UBOUND(InData%lin_C,1) + DbKiBuf(Db_Xferred) = InData%lin_C(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Nrrr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10376,8 +10951,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nrrr)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Nrrr))-1 ) = PACK(InData%Nrrr,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Nrrr) + DO i3 = LBOUND(InData%Nrrr,3), UBOUND(InData%Nrrr,3) + DO i2 = LBOUND(InData%Nrrr,2), UBOUND(InData%Nrrr,2) + DO i1 = LBOUND(InData%Nrrr,1), UBOUND(InData%Nrrr,1) + DbKiBuf(Db_Xferred) = InData%Nrrr(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10392,8 +10973,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elf)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elf))-1 ) = PACK(InData%elf,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elf) + DO i2 = LBOUND(InData%elf,2), UBOUND(InData%elf,2) + DO i1 = LBOUND(InData%elf,1), UBOUND(InData%elf,1) + DbKiBuf(Db_Xferred) = InData%elf(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%EFint) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10411,8 +10996,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EFint)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%EFint))-1 ) = PACK(InData%EFint,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%EFint) + DO i3 = LBOUND(InData%EFint,3), UBOUND(InData%EFint,3) + DO i2 = LBOUND(InData%EFint,2), UBOUND(InData%EFint,2) + DO i1 = LBOUND(InData%EFint,1), UBOUND(InData%EFint,1) + DbKiBuf(Db_Xferred) = InData%EFint(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elk) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10433,8 +11024,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elk)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elk))-1 ) = PACK(InData%elk,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elk) + DO i4 = LBOUND(InData%elk,4), UBOUND(InData%elk,4) + DO i3 = LBOUND(InData%elk,3), UBOUND(InData%elk,3) + DO i2 = LBOUND(InData%elk,2), UBOUND(InData%elk,2) + DO i1 = LBOUND(InData%elk,1), UBOUND(InData%elk,1) + DbKiBuf(Db_Xferred) = InData%elk(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10455,8 +11054,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elg)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elg))-1 ) = PACK(InData%elg,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elg) + DO i4 = LBOUND(InData%elg,4), UBOUND(InData%elg,4) + DO i3 = LBOUND(InData%elg,3), UBOUND(InData%elg,3) + DO i2 = LBOUND(InData%elg,2), UBOUND(InData%elg,2) + DO i1 = LBOUND(InData%elg,1), UBOUND(InData%elg,1) + DbKiBuf(Db_Xferred) = InData%elg(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10477,8 +11084,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elm)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elm))-1 ) = PACK(InData%elm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elm) + DO i4 = LBOUND(InData%elm,4), UBOUND(InData%elm,4) + DO i3 = LBOUND(InData%elm,3), UBOUND(InData%elm,3) + DO i2 = LBOUND(InData%elm,2), UBOUND(InData%elm,2) + DO i1 = LBOUND(InData%elm,1), UBOUND(InData%elm,1) + DbKiBuf(Db_Xferred) = InData%elm(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DistrLoad_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10496,8 +11111,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DistrLoad_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DistrLoad_QP))-1 ) = PACK(InData%DistrLoad_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DistrLoad_QP) + DO i3 = LBOUND(InData%DistrLoad_QP,3), UBOUND(InData%DistrLoad_QP,3) + DO i2 = LBOUND(InData%DistrLoad_QP,2), UBOUND(InData%DistrLoad_QP,2) + DO i1 = LBOUND(InData%DistrLoad_QP,1), UBOUND(InData%DistrLoad_QP,1) + DbKiBuf(Db_Xferred) = InData%DistrLoad_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PointLoadLcl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10512,8 +11133,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PointLoadLcl)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%PointLoadLcl))-1 ) = PACK(InData%PointLoadLcl,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%PointLoadLcl) + DO i2 = LBOUND(InData%PointLoadLcl,2), UBOUND(InData%PointLoadLcl,2) + DO i1 = LBOUND(InData%PointLoadLcl,1), UBOUND(InData%PointLoadLcl,1) + DbKiBuf(Db_Xferred) = InData%PointLoadLcl(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StifK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10534,8 +11159,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StifK)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StifK))-1 ) = PACK(InData%StifK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StifK) + DO i4 = LBOUND(InData%StifK,4), UBOUND(InData%StifK,4) + DO i3 = LBOUND(InData%StifK,3), UBOUND(InData%StifK,3) + DO i2 = LBOUND(InData%StifK,2), UBOUND(InData%StifK,2) + DO i1 = LBOUND(InData%StifK,1), UBOUND(InData%StifK,1) + DbKiBuf(Db_Xferred) = InData%StifK(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10556,8 +11189,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassM)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%MassM))-1 ) = PACK(InData%MassM,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%MassM) + DO i4 = LBOUND(InData%MassM,4), UBOUND(InData%MassM,4) + DO i3 = LBOUND(InData%MassM,3), UBOUND(InData%MassM,3) + DO i2 = LBOUND(InData%MassM,2), UBOUND(InData%MassM,2) + DO i1 = LBOUND(InData%MassM,1), UBOUND(InData%MassM,1) + DbKiBuf(Db_Xferred) = InData%MassM(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DampG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10578,8 +11219,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DampG)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DampG))-1 ) = PACK(InData%DampG,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DampG) + DO i4 = LBOUND(InData%DampG,4), UBOUND(InData%DampG,4) + DO i3 = LBOUND(InData%DampG,3), UBOUND(InData%DampG,3) + DO i2 = LBOUND(InData%DampG,2), UBOUND(InData%DampG,2) + DO i1 = LBOUND(InData%DampG,1), UBOUND(InData%DampG,1) + DbKiBuf(Db_Xferred) = InData%DampG(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StifK_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10600,8 +11249,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StifK_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StifK_fd))-1 ) = PACK(InData%StifK_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StifK_fd) + DO i4 = LBOUND(InData%StifK_fd,4), UBOUND(InData%StifK_fd,4) + DO i3 = LBOUND(InData%StifK_fd,3), UBOUND(InData%StifK_fd,3) + DO i2 = LBOUND(InData%StifK_fd,2), UBOUND(InData%StifK_fd,2) + DO i1 = LBOUND(InData%StifK_fd,1), UBOUND(InData%StifK_fd,1) + DbKiBuf(Db_Xferred) = InData%StifK_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassM_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10622,8 +11279,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassM_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%MassM_fd))-1 ) = PACK(InData%MassM_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%MassM_fd) + DO i4 = LBOUND(InData%MassM_fd,4), UBOUND(InData%MassM_fd,4) + DO i3 = LBOUND(InData%MassM_fd,3), UBOUND(InData%MassM_fd,3) + DO i2 = LBOUND(InData%MassM_fd,2), UBOUND(InData%MassM_fd,2) + DO i1 = LBOUND(InData%MassM_fd,1), UBOUND(InData%MassM_fd,1) + DbKiBuf(Db_Xferred) = InData%MassM_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DampG_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10644,8 +11309,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DampG_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DampG_fd))-1 ) = PACK(InData%DampG_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DampG_fd) + DO i4 = LBOUND(InData%DampG_fd,4), UBOUND(InData%DampG_fd,4) + DO i3 = LBOUND(InData%DampG_fd,3), UBOUND(InData%DampG_fd,3) + DO i2 = LBOUND(InData%DampG_fd,2), UBOUND(InData%DampG_fd,2) + DO i1 = LBOUND(InData%DampG_fd,1), UBOUND(InData%DampG_fd,1) + DbKiBuf(Db_Xferred) = InData%DampG_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10660,8 +11333,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS))-1 ) = PACK(InData%RHS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS) + DO i2 = LBOUND(InData%RHS,2), UBOUND(InData%RHS,2) + DO i1 = LBOUND(InData%RHS,1), UBOUND(InData%RHS,1) + DbKiBuf(Db_Xferred) = InData%RHS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS_p) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10676,8 +11353,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS_p)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS_p))-1 ) = PACK(InData%RHS_p,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS_p) + DO i2 = LBOUND(InData%RHS_p,2), UBOUND(InData%RHS_p,2) + DO i1 = LBOUND(InData%RHS_p,1), UBOUND(InData%RHS_p,1) + DbKiBuf(Db_Xferred) = InData%RHS_p(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS_m) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10692,8 +11373,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS_m)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS_m))-1 ) = PACK(InData%RHS_m,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS_m) + DO i2 = LBOUND(InData%RHS_m,2), UBOUND(InData%RHS_m,2) + DO i1 = LBOUND(InData%RHS_m,1), UBOUND(InData%RHS_m,1) + DbKiBuf(Db_Xferred) = InData%RHS_m(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldInternalForceFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10708,8 +11393,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldInternalForceFE)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BldInternalForceFE))-1 ) = PACK(InData%BldInternalForceFE,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BldInternalForceFE) + DO i2 = LBOUND(InData%BldInternalForceFE,2), UBOUND(InData%BldInternalForceFE,2) + DO i1 = LBOUND(InData%BldInternalForceFE,1), UBOUND(InData%BldInternalForceFE,1) + DbKiBuf(Db_Xferred) = InData%BldInternalForceFE(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldInternalForceQP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10724,8 +11413,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldInternalForceQP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BldInternalForceQP))-1 ) = PACK(InData%BldInternalForceQP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BldInternalForceQP) + DO i2 = LBOUND(InData%BldInternalForceQP,2), UBOUND(InData%BldInternalForceQP,2) + DO i1 = LBOUND(InData%BldInternalForceQP,1), UBOUND(InData%BldInternalForceQP,1) + DbKiBuf(Db_Xferred) = InData%BldInternalForceQP(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10737,8 +11430,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstNodeReactionLclForceMoment,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstNodeReactionLclForceMoment)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%FirstNodeReactionLclForceMoment))-1 ) = PACK(InData%FirstNodeReactionLclForceMoment,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%FirstNodeReactionLclForceMoment) + DO i1 = LBOUND(InData%FirstNodeReactionLclForceMoment,1), UBOUND(InData%FirstNodeReactionLclForceMoment,1) + DbKiBuf(Db_Xferred) = InData%FirstNodeReactionLclForceMoment(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Solution) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10753,8 +11448,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Solution)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Solution))-1 ) = PACK(InData%Solution,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Solution) + DO i2 = LBOUND(InData%Solution,2), UBOUND(InData%Solution,2) + DO i1 = LBOUND(InData%Solution,1), UBOUND(InData%Solution,1) + DbKiBuf(Db_Xferred) = InData%Solution(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_StifK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10769,8 +11468,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_StifK)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_StifK))-1 ) = PACK(InData%LP_StifK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_StifK) + DO i2 = LBOUND(InData%LP_StifK,2), UBOUND(InData%LP_StifK,2) + DO i1 = LBOUND(InData%LP_StifK,1), UBOUND(InData%LP_StifK,1) + DbKiBuf(Db_Xferred) = InData%LP_StifK(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_MassM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10785,8 +11488,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_MassM)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_MassM))-1 ) = PACK(InData%LP_MassM,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_MassM) + DO i2 = LBOUND(InData%LP_MassM,2), UBOUND(InData%LP_MassM,2) + DO i1 = LBOUND(InData%LP_MassM,1), UBOUND(InData%LP_MassM,1) + DbKiBuf(Db_Xferred) = InData%LP_MassM(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_MassM_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10801,8 +11508,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_MassM_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_MassM_LU))-1 ) = PACK(InData%LP_MassM_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_MassM_LU) + DO i2 = LBOUND(InData%LP_MassM_LU,2), UBOUND(InData%LP_MassM_LU,2) + DO i1 = LBOUND(InData%LP_MassM_LU,1), UBOUND(InData%LP_MassM_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_MassM_LU(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_RHS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10814,8 +11525,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_RHS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_RHS))-1 ) = PACK(InData%LP_RHS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_RHS) + DO i1 = LBOUND(InData%LP_RHS,1), UBOUND(InData%LP_RHS,1) + DbKiBuf(Db_Xferred) = InData%LP_RHS(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_StifK_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10830,8 +11543,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_StifK_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_StifK_LU))-1 ) = PACK(InData%LP_StifK_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_StifK_LU) + DO i2 = LBOUND(InData%LP_StifK_LU,2), UBOUND(InData%LP_StifK_LU,2) + DO i1 = LBOUND(InData%LP_StifK_LU,1), UBOUND(InData%LP_StifK_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_StifK_LU(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_RHS_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10843,8 +11560,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS_LU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_RHS_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_RHS_LU))-1 ) = PACK(InData%LP_RHS_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_RHS_LU) + DO i1 = LBOUND(InData%LP_RHS_LU,1), UBOUND(InData%LP_RHS_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_RHS_LU(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10856,8 +11575,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_indx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LP_indx))-1 ) = PACK(InData%LP_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LP_indx) + DO i1 = LBOUND(InData%LP_indx,1), UBOUND(InData%LP_indx,1) + IntKiBuf(Int_Xferred) = InData%LP_indx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10930,12 +11651,6 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -11113,8 +11828,8 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Un_Sum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Un_Sum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11171,15 +11886,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%lin_A)>0) OutData%lin_A = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%lin_A))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%lin_A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%lin_A,2), UBOUND(OutData%lin_A,2) + DO i1 = LBOUND(OutData%lin_A,1), UBOUND(OutData%lin_A,1) + OutData%lin_A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_C not allocated Int_Xferred = Int_Xferred + 1 @@ -11197,15 +11909,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%lin_C)>0) OutData%lin_C = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%lin_C))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%lin_C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%lin_C,2), UBOUND(OutData%lin_C,2) + DO i1 = LBOUND(OutData%lin_C,1), UBOUND(OutData%lin_C,1) + OutData%lin_C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nrrr not allocated Int_Xferred = Int_Xferred + 1 @@ -11226,15 +11935,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Nrrr)>0) OutData%Nrrr = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Nrrr))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Nrrr) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Nrrr,3), UBOUND(OutData%Nrrr,3) + DO i2 = LBOUND(OutData%Nrrr,2), UBOUND(OutData%Nrrr,2) + DO i1 = LBOUND(OutData%Nrrr,1), UBOUND(OutData%Nrrr,1) + OutData%Nrrr(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elf not allocated Int_Xferred = Int_Xferred + 1 @@ -11252,15 +11960,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%elf)>0) OutData%elf = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elf))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elf) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%elf,2), UBOUND(OutData%elf,2) + DO i1 = LBOUND(OutData%elf,1), UBOUND(OutData%elf,1) + OutData%elf(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EFint not allocated Int_Xferred = Int_Xferred + 1 @@ -11281,15 +11986,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%EFint)>0) OutData%EFint = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%EFint))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%EFint) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%EFint,3), UBOUND(OutData%EFint,3) + DO i2 = LBOUND(OutData%EFint,2), UBOUND(OutData%EFint,2) + DO i1 = LBOUND(OutData%EFint,1), UBOUND(OutData%EFint,1) + OutData%EFint(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elk not allocated Int_Xferred = Int_Xferred + 1 @@ -11313,15 +12017,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elk)>0) OutData%elk = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elk))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elk) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elk,4), UBOUND(OutData%elk,4) + DO i3 = LBOUND(OutData%elk,3), UBOUND(OutData%elk,3) + DO i2 = LBOUND(OutData%elk,2), UBOUND(OutData%elk,2) + DO i1 = LBOUND(OutData%elk,1), UBOUND(OutData%elk,1) + OutData%elk(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elg not allocated Int_Xferred = Int_Xferred + 1 @@ -11345,15 +12050,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elg)>0) OutData%elg = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elg))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elg) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elg,4), UBOUND(OutData%elg,4) + DO i3 = LBOUND(OutData%elg,3), UBOUND(OutData%elg,3) + DO i2 = LBOUND(OutData%elg,2), UBOUND(OutData%elg,2) + DO i1 = LBOUND(OutData%elg,1), UBOUND(OutData%elg,1) + OutData%elg(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elm not allocated Int_Xferred = Int_Xferred + 1 @@ -11377,15 +12083,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elm)>0) OutData%elm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elm))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elm) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elm,4), UBOUND(OutData%elm,4) + DO i3 = LBOUND(OutData%elm,3), UBOUND(OutData%elm,3) + DO i2 = LBOUND(OutData%elm,2), UBOUND(OutData%elm,2) + DO i1 = LBOUND(OutData%elm,1), UBOUND(OutData%elm,1) + OutData%elm(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DistrLoad_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -11406,15 +12113,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DistrLoad_QP)>0) OutData%DistrLoad_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DistrLoad_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DistrLoad_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DistrLoad_QP,3), UBOUND(OutData%DistrLoad_QP,3) + DO i2 = LBOUND(OutData%DistrLoad_QP,2), UBOUND(OutData%DistrLoad_QP,2) + DO i1 = LBOUND(OutData%DistrLoad_QP,1), UBOUND(OutData%DistrLoad_QP,1) + OutData%DistrLoad_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointLoadLcl not allocated Int_Xferred = Int_Xferred + 1 @@ -11432,15 +12138,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PointLoadLcl)>0) OutData%PointLoadLcl = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%PointLoadLcl))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%PointLoadLcl) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PointLoadLcl,2), UBOUND(OutData%PointLoadLcl,2) + DO i1 = LBOUND(OutData%PointLoadLcl,1), UBOUND(OutData%PointLoadLcl,1) + OutData%PointLoadLcl(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK not allocated Int_Xferred = Int_Xferred + 1 @@ -11464,15 +12167,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%StifK)>0) OutData%StifK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StifK))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StifK) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%StifK,4), UBOUND(OutData%StifK,4) + DO i3 = LBOUND(OutData%StifK,3), UBOUND(OutData%StifK,3) + DO i2 = LBOUND(OutData%StifK,2), UBOUND(OutData%StifK,2) + DO i1 = LBOUND(OutData%StifK,1), UBOUND(OutData%StifK,1) + OutData%StifK(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM not allocated Int_Xferred = Int_Xferred + 1 @@ -11496,15 +12200,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%MassM)>0) OutData%MassM = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%MassM))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%MassM) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%MassM,4), UBOUND(OutData%MassM,4) + DO i3 = LBOUND(OutData%MassM,3), UBOUND(OutData%MassM,3) + DO i2 = LBOUND(OutData%MassM,2), UBOUND(OutData%MassM,2) + DO i1 = LBOUND(OutData%MassM,1), UBOUND(OutData%MassM,1) + OutData%MassM(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG not allocated Int_Xferred = Int_Xferred + 1 @@ -11528,15 +12233,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%DampG)>0) OutData%DampG = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DampG))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DampG) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%DampG,4), UBOUND(OutData%DampG,4) + DO i3 = LBOUND(OutData%DampG,3), UBOUND(OutData%DampG,3) + DO i2 = LBOUND(OutData%DampG,2), UBOUND(OutData%DampG,2) + DO i1 = LBOUND(OutData%DampG,1), UBOUND(OutData%DampG,1) + OutData%DampG(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11560,15 +12266,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%StifK_fd)>0) OutData%StifK_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StifK_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StifK_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%StifK_fd,4), UBOUND(OutData%StifK_fd,4) + DO i3 = LBOUND(OutData%StifK_fd,3), UBOUND(OutData%StifK_fd,3) + DO i2 = LBOUND(OutData%StifK_fd,2), UBOUND(OutData%StifK_fd,2) + DO i1 = LBOUND(OutData%StifK_fd,1), UBOUND(OutData%StifK_fd,1) + OutData%StifK_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11592,15 +12299,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%MassM_fd)>0) OutData%MassM_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%MassM_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%MassM_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%MassM_fd,4), UBOUND(OutData%MassM_fd,4) + DO i3 = LBOUND(OutData%MassM_fd,3), UBOUND(OutData%MassM_fd,3) + DO i2 = LBOUND(OutData%MassM_fd,2), UBOUND(OutData%MassM_fd,2) + DO i1 = LBOUND(OutData%MassM_fd,1), UBOUND(OutData%MassM_fd,1) + OutData%MassM_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11624,15 +12332,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%DampG_fd)>0) OutData%DampG_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DampG_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DampG_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%DampG_fd,4), UBOUND(OutData%DampG_fd,4) + DO i3 = LBOUND(OutData%DampG_fd,3), UBOUND(OutData%DampG_fd,3) + DO i2 = LBOUND(OutData%DampG_fd,2), UBOUND(OutData%DampG_fd,2) + DO i1 = LBOUND(OutData%DampG_fd,1), UBOUND(OutData%DampG_fd,1) + OutData%DampG_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS not allocated Int_Xferred = Int_Xferred + 1 @@ -11650,15 +12359,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS)>0) OutData%RHS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS,2), UBOUND(OutData%RHS,2) + DO i1 = LBOUND(OutData%RHS,1), UBOUND(OutData%RHS,1) + OutData%RHS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_p not allocated Int_Xferred = Int_Xferred + 1 @@ -11676,15 +12382,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS_p)>0) OutData%RHS_p = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS_p))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS_p) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS_p,2), UBOUND(OutData%RHS_p,2) + DO i1 = LBOUND(OutData%RHS_p,1), UBOUND(OutData%RHS_p,1) + OutData%RHS_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_m not allocated Int_Xferred = Int_Xferred + 1 @@ -11702,15 +12405,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS_m)>0) OutData%RHS_m = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS_m))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS_m) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS_m,2), UBOUND(OutData%RHS_m,2) + DO i1 = LBOUND(OutData%RHS_m,1), UBOUND(OutData%RHS_m,1) + OutData%RHS_m(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceFE not allocated Int_Xferred = Int_Xferred + 1 @@ -11728,15 +12428,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldInternalForceFE)>0) OutData%BldInternalForceFE = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BldInternalForceFE))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BldInternalForceFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldInternalForceFE,2), UBOUND(OutData%BldInternalForceFE,2) + DO i1 = LBOUND(OutData%BldInternalForceFE,1), UBOUND(OutData%BldInternalForceFE,1) + OutData%BldInternalForceFE(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceQP not allocated Int_Xferred = Int_Xferred + 1 @@ -11754,15 +12451,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldInternalForceQP)>0) OutData%BldInternalForceQP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BldInternalForceQP))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BldInternalForceQP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldInternalForceQP,2), UBOUND(OutData%BldInternalForceQP,2) + DO i1 = LBOUND(OutData%BldInternalForceQP,1), UBOUND(OutData%BldInternalForceQP,1) + OutData%BldInternalForceQP(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstNodeReactionLclForceMoment not allocated Int_Xferred = Int_Xferred + 1 @@ -11777,15 +12471,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FirstNodeReactionLclForceMoment)>0) OutData%FirstNodeReactionLclForceMoment = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%FirstNodeReactionLclForceMoment))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%FirstNodeReactionLclForceMoment) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FirstNodeReactionLclForceMoment,1), UBOUND(OutData%FirstNodeReactionLclForceMoment,1) + OutData%FirstNodeReactionLclForceMoment(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Solution not allocated Int_Xferred = Int_Xferred + 1 @@ -11803,15 +12492,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Solution)>0) OutData%Solution = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Solution))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Solution) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Solution,2), UBOUND(OutData%Solution,2) + DO i1 = LBOUND(OutData%Solution,1), UBOUND(OutData%Solution,1) + OutData%Solution(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK not allocated Int_Xferred = Int_Xferred + 1 @@ -11829,15 +12515,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_StifK)>0) OutData%LP_StifK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_StifK))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_StifK) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_StifK,2), UBOUND(OutData%LP_StifK,2) + DO i1 = LBOUND(OutData%LP_StifK,1), UBOUND(OutData%LP_StifK,1) + OutData%LP_StifK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM not allocated Int_Xferred = Int_Xferred + 1 @@ -11855,15 +12538,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_MassM)>0) OutData%LP_MassM = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_MassM))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_MassM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_MassM,2), UBOUND(OutData%LP_MassM,2) + DO i1 = LBOUND(OutData%LP_MassM,1), UBOUND(OutData%LP_MassM,1) + OutData%LP_MassM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11881,15 +12561,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_MassM_LU)>0) OutData%LP_MassM_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_MassM_LU))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_MassM_LU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_MassM_LU,2), UBOUND(OutData%LP_MassM_LU,2) + DO i1 = LBOUND(OutData%LP_MassM_LU,1), UBOUND(OutData%LP_MassM_LU,1) + OutData%LP_MassM_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS not allocated Int_Xferred = Int_Xferred + 1 @@ -11904,15 +12581,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_RHS)>0) OutData%LP_RHS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_RHS))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_RHS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_RHS,1), UBOUND(OutData%LP_RHS,1) + OutData%LP_RHS(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11930,15 +12602,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_StifK_LU)>0) OutData%LP_StifK_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_StifK_LU))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_StifK_LU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_StifK_LU,2), UBOUND(OutData%LP_StifK_LU,2) + DO i1 = LBOUND(OutData%LP_StifK_LU,1), UBOUND(OutData%LP_StifK_LU,1) + OutData%LP_StifK_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11953,15 +12622,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_RHS_LU)>0) OutData%LP_RHS_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_RHS_LU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_RHS_LU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_RHS_LU,1), UBOUND(OutData%LP_RHS_LU,1) + OutData%LP_RHS_LU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -11976,15 +12640,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_indx)>0) OutData%LP_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LP_indx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LP_indx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_indx,1), UBOUND(OutData%LP_indx,1) + OutData%LP_indx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -12143,8 +12802,8 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -12159,6 +12818,8 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) @@ -12196,8 +12857,9 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp2' @@ -12219,6 +12881,8 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) @@ -12304,12 +12968,12 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -12322,21 +12986,21 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b0 = -(y1%RootMxr - y2%RootMxr)/t(2) - y_out%RootMxr = y1%RootMxr + b0 * t_out - b0 = -(y1%RootMyr - y2%RootMyr)/t(2) - y_out%RootMyr = y1%RootMyr + b0 * t_out + b = -(y1%RootMxr - y2%RootMxr) + y_out%RootMxr = y1%RootMxr + b * ScaleFactor + b = -(y1%RootMyr - y2%RootMyr) + y_out%RootMyr = y1%RootMyr + b * ScaleFactor IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE BD_Output_ExtrapInterp1 @@ -12367,13 +13031,14 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -12392,24 +13057,24 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b0 = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMxr = y1%RootMxr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMyr = y1%RootMyr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) * scaleFactor + y_out%RootMxr = y1%RootMxr + b + c * t_out + b = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) * scaleFactor + y_out%RootMyr = y1%RootMyr + b + c * t_out IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE BD_Output_ExtrapInterp2 diff --git a/modules/beamdyn/src/Driver_Beam.f90 b/modules/beamdyn/src/Driver_Beam.f90 index b7ea7f74a4..8c11cb9a59 100644 --- a/modules/beamdyn/src/Driver_Beam.f90 +++ b/modules/beamdyn/src/Driver_Beam.f90 @@ -81,11 +81,11 @@ PROGRAM BeamDyn_Driver_Program CALL NWTC_Init() ! Display the copyright notice - CALL DispCopyrightLicense( version ) + CALL DispCopyrightLicense( version%Name ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running - CALL WrScr( ' Running '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) + CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) ! ------------------------------------------------------------------------- ! Initialization of glue-code time-step variables diff --git a/modules/beamdyn/src/OutListParameters.xlsx b/modules/beamdyn/src/OutListParameters.xlsx deleted file mode 100644 index 4a37cfa546..0000000000 Binary files a/modules/beamdyn/src/OutListParameters.xlsx and /dev/null differ diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 00f12ddfcc..63feed3b38 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -52,6 +52,7 @@ typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue)" - typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - # ..... Blade Input file data........................................................................ typedef ^ BladeInputData IntKi station_total - - - "Number of blade input stations" @@ -108,6 +109,11 @@ typedef ^ BD_InputFile CHARACTER(ChanLen) OutList {:} - - "List typedef ^ BD_InputFile LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - typedef ^ BD_InputFile CHARACTER(20) OutFmt - - - "Format specifier" - +# ..... BldNdOuts ............................................................................................ +typedef ^ BD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (BD_BldNdOuts)" - +typedef ^ BD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (BD_BldNdOuts)" - +typedef ^ BD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (BD_BldNdOuts)" - +typedef ^ BD_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (BD_BldNdOuts)" - # ..... States @@ -209,6 +215,7 @@ typedef ^ ParameterType OutParmType OutParam {:} - - typedef ^ ParameterType IntKi NNodeOuts - - - "Number of nodes to output data to a file[0 - 9]" - typedef ^ ParameterType IntKi OutNd {9} - - "Nodes whose values will be output" - typedef ^ ParameterType IntKi NdIndx {:} - - "Index into BldMotion mesh (to number the nodes for output without using collocated nodes)" - +typedef ^ ParameterType IntKi NdIndxInverse {:} - - "Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes)" - typedef ^ ParameterType IntKi OutNd2NdElem {:}{:} - - "To go from an output node number to a node/elem pair" - typedef ^ ParameterType CHARACTER(20) OutFmt - - - "Format specifier" - typedef ^ ParameterType Logical UsePitchAct - - - "Whether to use a pitch actuator inside BeamDyn" (flag) @@ -223,6 +230,11 @@ typedef ^ ParameterType Logical tngt_stf_fd - - - typedef ^ ParameterType Logical tngt_stf_comp - - - "Flag to compare finite differenced and analytical tangent stifness" - typedef ^ ParameterType R8Ki tngt_stf_pert - - - "Perturbation size for computing finite differenced tangent stiffness" - typedef ^ ParameterType R8Ki tngt_stf_difftol - - - "When comparing tangent stiffness matrix, stop simulation if error greater than this" - +# .... BD_BlNdOuts ........................................................................................................ +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "[BD_BldNdOuts] Number of requested output channels per blade node" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "[BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "[BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "[BD_BldNdOuts] The blade nodes to actually output" - # .... arrays for optimization ........................................................................................................ typedef ^ ParameterType R8Ki QPtw_Shp_Shp_Jac {:}{:}{:}{:} - - "optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem)" - typedef ^ ParameterType ^ QPtw_Shp_ShpDer {:}{:}{:} - - "optimization variable: QPtw_Shp_ShpDer(idx_qp,i,j) = p%Shp(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp)" - diff --git a/modules/elastodyn/CMakeLists.txt b/modules/elastodyn/CMakeLists.txt index 8571acf72b..5610748e9c 100644 --- a/modules/elastodyn/CMakeLists.txt +++ b/modules/elastodyn/CMakeLists.txt @@ -21,6 +21,7 @@ endif() set(ED_SOURCES src/ElastoDyn.f90 src/ElastoDyn_IO.f90 + src/ElastoDyn_AllBldNdOuts_IO.f90 src/ED_UserSubs.f90 src/ElastoDyn_Types.f90 ) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 6c702c0492..2e0c2814e2 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -28,6 +28,8 @@ MODULE ElastoDyn USE ED_UserSubs ! <- module not in the FAST Framework! + USE ElastoDyn_AllBldNdOuts_IO + IMPLICIT NONE PRIVATE @@ -95,7 +97,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut TYPE(ED_InputFile) :: InputFileData ! Data stored in the module's input file INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: i, K ! loop counters + INTEGER(IntKi) :: i ! loop counters LOGICAL, PARAMETER :: GetAdamsVals = .FALSE. ! Determines if we should read Adams values and create (update) an Adams model CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -214,10 +216,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ ! Define initialization-routine output here: !............................................................................................ - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) + + CALL AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -225,6 +228,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do + + ! Set the info in WriteOutputHdr and WriteOutputUnt + CALL AllBldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN InitOut%Ver = ED_Ver InitOut%NumBl = p%NumBl @@ -236,6 +244,9 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%HubHt = p%HubHt InitOut%TwrBasePos = y%TowerLn2Mesh%Position(:,p%TwrNodes + 2) InitOut%HubRad = p%HubRad + InitOut%RotSpeed = p%RotSpeed + InitOut%isFixed_GenDOF = .not. InputFileData%GenDOF + if (.not. p%BD4Blades) then ALLOCATE(InitOut%BldRNodes(p%BldNodes), STAT=ErrStat2) @@ -305,7 +316,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -855,6 +866,11 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) rOPO = m%RtHS%rT0O - p%TwrFlexL*m%CoordSys%a2 ! Position vector from the undeflected tower top (point O prime) to the deflected tower top (point O). + ! p%TwrNodes+1 is the tower top: + J = p%TwrNodes+1 + m%AllOuts(TwrTpTDxi) = m%RtHS%rO(1) - y%TowerLn2Mesh%Position(1,J) + m%AllOuts(TwrTpTDyi) = -1.*m%RtHS%rO(3) - y%TowerLn2Mesh%Position(2,J) + m%AllOuts(TwrTpTDzi) = m%RtHS%rO(2) - y%TowerLn2Mesh%Position(3,J) + p%PtfmRefzt m%AllOuts(YawBrTDxp) = DOT_PRODUCT( rOPO, m%CoordSys%b1 ) m%AllOuts(YawBrTDyp) = -DOT_PRODUCT( rOPO, m%CoordSys%b3 ) m%AllOuts(YawBrTDzp) = DOT_PRODUCT( rOPO, m%CoordSys%b2 ) @@ -1286,7 +1302,15 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ENDDO ! I - All selected output channels - + IF ( .NOT. p%BD4Blades ) THEN + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteAllBldNdOutput( p, u, m, y, LinAccES, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'ED_CalcOutput') + ENDIF + + !............................................................................................................................... ! Outputs required for AeroDyn !............................................................................................................................... @@ -2010,8 +2034,12 @@ SUBROUTINE ED_SetParameters( InputFileData, p, ErrStat, ErrMsg ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN + CALL AllBldNdOuts_SetParameters( p, InputFileData, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF ( ErrStat >= AbortErrLev ) RETURN + !p%BldNd_NumOuts = 0_IntKi + !p%BldNd_TotNumOuts = 0_IntKi - CONTAINS !............................................................................................................................... SUBROUTINE CheckError(ErrID,Msg) @@ -2068,7 +2096,7 @@ SUBROUTINE Init_DOFparameters( InputFileData, p, ErrStat, ErrMsg ) IF ( p%NumBl == 2 ) THEN p%NDOF = 22 ELSE - p%NDOF = 24 + p%NDOF = ED_MaxDOFs ENDIF p%NAug = p%NDOF + 1 @@ -3855,27 +3883,29 @@ END SUBROUTINE Init_MiscOtherStates ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" ! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these ! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! This code was generated by Write_ChckOutLst.m at 02-Mar-2015 10:37:31. !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 08-Jun-2020 17:05:31. SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) -! This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a -! warning if any of the channels are not available outputs from the module. -! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). -! the sign is set to 0 if the channel is invalid. -! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. !.................................................................................................................................. IMPLICIT NONE ! Passed variables - CHARACTER(ChanLen), INTENT(IN) :: OutList(:) ! The list out user-requested outputs - TYPE(ED_ParameterType), INTENT(INOUT) :: p ! The module parameters - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred ! Local variables + INTEGER :: ErrStat2 ! temporary (local) error status INTEGER :: I ! Generic loop-counting index INTEGER :: J ! Generic loop-counting index INTEGER :: INDX ! Index for valid arrays @@ -3884,8 +3914,9 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) 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(972) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(978) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "AZIMUTH ","BLDPITCH1","BLDPITCH2","BLDPITCH3","BLPITCH1 ","BLPITCH2 ","BLPITCH3 ", & "GENACCEL ","GENSPEED ","HSSBRTQ ","HSSHFTA ","HSSHFTPWR","HSSHFTTQ ","HSSHFTV ", & "IPDEFL1 ","IPDEFL2 ","IPDEFL3 ","LSSGAGA ","LSSGAGAXA","LSSGAGAXS","LSSGAGFXA", & @@ -4018,14 +4049,15 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) "TWHT9FLXT","TWHT9FLYT","TWHT9FLZT","TWHT9MLXT","TWHT9MLYT","TWHT9MLZT","TWHT9RDXT", & "TWHT9RDYT","TWHT9RDZT","TWHT9RPXI","TWHT9RPYI","TWHT9RPZI","TWHT9TDXT","TWHT9TDYT", & "TWHT9TDZT","TWHT9TPXI","TWHT9TPYI","TWHT9TPZI","TWRBSFXT ","TWRBSFYT ","TWRBSFZT ", & - "TWRBSMXT ","TWRBSMYT ","TWRBSMZT ","TWRCLRNC1","TWRCLRNC2","TWRCLRNC3","TWSTDEFL1", & - "TWSTDEFL2","TWSTDEFL3","YAWACCEL ","YAWAZN ","YAWAZP ","YAWBRFXN ","YAWBRFXP ", & - "YAWBRFYN ","YAWBRFYP ","YAWBRFZN ","YAWBRFZP ","YAWBRMXN ","YAWBRMXP ","YAWBRMYN ", & - "YAWBRMYP ","YAWBRMZN ","YAWBRMZP ","YAWBRRAXP","YAWBRRAYP","YAWBRRAZP","YAWBRRDXT", & - "YAWBRRDYT","YAWBRRDZT","YAWBRRVXP","YAWBRRVYP","YAWBRRVZP","YAWBRTAXP","YAWBRTAYP", & - "YAWBRTAZP","YAWBRTDXP","YAWBRTDXT","YAWBRTDYP","YAWBRTDYT","YAWBRTDZP","YAWBRTDZT", & - "YAWPOS ","YAWPZN ","YAWPZP ","YAWRATE ","YAWVZN ","YAWVZP "/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(972) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + "TWRBSMXT ","TWRBSMYT ","TWRBSMZT ","TWRCLRNC1","TWRCLRNC2","TWRCLRNC3","TWRTPTDXI", & + "TWRTPTDYI","TWRTPTDZI","TWSTDEFL1","TWSTDEFL2","TWSTDEFL3","YAWACCEL ","YAWAZN ", & + "YAWAZP ","YAWBRFXN ","YAWBRFXP ","YAWBRFYN ","YAWBRFYP ","YAWBRFZN ","YAWBRFZP ", & + "YAWBRMXN ","YAWBRMXP ","YAWBRMYN ","YAWBRMYP ","YAWBRMZN ","YAWBRMZP ","YAWBRRAXP", & + "YAWBRRAYP","YAWBRRAZP","YAWBRRDXT","YAWBRRDYT","YAWBRRDZT","YAWBRRVXP","YAWBRRVYP", & + "YAWBRRVZP","YAWBRTAXP","YAWBRTAYP","YAWBRTAZP","YAWBRTDXI","YAWBRTDXP","YAWBRTDXT", & + "YAWBRTDYI","YAWBRTDYP","YAWBRTDYT","YAWBRTDZI","YAWBRTDZP","YAWBRTDZT","YAWPOS ", & + "YAWPZN ","YAWPZP ","YAWRATE ","YAWVZN ","YAWVZP "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(978) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) LSSTipPxa , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , & HSShftA , HSShftV , HSSBrTq , HSShftA , HSShftPwr , HSShftTq , HSShftV , & TipDyc1 , TipDyc2 , TipDyc3 , LSSGagAxa , LSSGagAxa , LSSGagAxa , LSShftFxa , & @@ -4158,14 +4190,15 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) TwHt9FLxt , TwHt9FLyt , TwHt9FLzt , TwHt9MLxt , TwHt9MLyt , TwHt9MLzt , TwHt9RDxt , & TwHt9RDyt , TwHt9RDzt , TwHt9RPxi , TwHt9RPyi , TwHt9RPzi , TwHt9TDxt , TwHt9TDyt , & TwHt9TDzt , TwHt9TPxi , TwHt9TPyi , TwHt9TPzi , TwrBsFxt , TwrBsFyt , TwrBsFzt , & - TwrBsMxt , TwrBsMyt , TwrBsMzt , TipClrnc1 , TipClrnc2 , TipClrnc3 , TipRDzc1 , & - TipRDzc2 , TipRDzc3 , YawAzn , YawAzn , YawAzn , YawBrFxn , YawBrFxp , & - YawBrFyn , YawBrFyp , YawBrFzn , YawBrFzn , YawBrMxn , YawBrMxp , YawBrMyn , & - YawBrMyp , YawBrMzn , YawBrMzn , YawBrRAxp , YawBrRAyp , YawBrRAzp , YawBrRDxt , & - YawBrRDyt , YawBrRDzt , YawBrRVxp , YawBrRVyp , YawBrRVzp , YawBrTAxp , YawBrTAyp , & - YawBrTAzp , YawBrTDxp , YawBrTDxt , YawBrTDyp , YawBrTDyt , YawBrTDzp , YawBrTDzt , & - YawPzn , YawPzn , YawPzn , YawVzn , YawVzn , YawVzn /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(972) = (/ & ! This lists the units corresponding to the allowed parameters + TwrBsMxt , TwrBsMyt , TwrBsMzt , TipClrnc1 , TipClrnc2 , TipClrnc3 , TwrTpTDxi , & + TwrTpTDyi , TwrTpTDzi , TipRDzc1 , TipRDzc2 , TipRDzc3 , YawAzn , YawAzn , & + YawAzn , YawBrFxn , YawBrFxp , YawBrFyn , YawBrFyp , YawBrFzn , YawBrFzn , & + YawBrMxn , YawBrMxp , YawBrMyn , YawBrMyp , YawBrMzn , YawBrMzn , YawBrRAxp , & + YawBrRAyp , YawBrRAzp , YawBrRDxt , YawBrRDyt , YawBrRDzt , YawBrRVxp , YawBrRVyp , & + YawBrRVzp , YawBrTAxp , YawBrTAyp , YawBrTAzp , TwrTpTDxi , YawBrTDxp , YawBrTDxt , & + TwrTpTDyi , YawBrTDyp , YawBrTDyt , TwrTpTDzi , YawBrTDzp , YawBrTDzt , YawPzn , & + YawPzn , YawPzn , YawVzn , YawVzn , YawVzn /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(978) = (/ & ! This lists the units corresponding to the allowed parameters "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & "(deg/s^2) ","(rpm) ","(kN-m) ","(deg/s^2) ","(kW) ","(kN-m) ","(rpm) ", & "(m) ","(m) ","(m) ","(deg/s^2) ","(deg/s^2) ","(deg/s^2) ","(kN) ", & @@ -4298,13 +4331,14 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & "(m) ","(m) ","(m) ","(m) ","(kN) ","(kN) ","(kN) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(m) ","(m) ","(m) ","(deg) ", & - "(deg) ","(deg) ","(deg/s^2) ","(deg/s^2) ","(deg/s^2) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(deg/s^2) ","(deg/s^2) ","(deg/s^2) ","(deg) ", & - "(deg) ","(deg) ","(deg/s) ","(deg/s) ","(deg/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(deg) ","(deg) ","(deg) ","(deg/s) ","(deg/s) ","(deg/s) "/) + "(kN-m) ","(kN-m) ","(kN-m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(deg) ","(deg) ","(deg) ","(deg/s^2) ","(deg/s^2) ", & + "(deg/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg/s^2) ", & + "(deg/s^2) ","(deg/s^2) ","(deg) ","(deg) ","(deg) ","(deg/s) ","(deg/s) ", & + "(deg/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(deg) ", & + "(deg) ","(deg) ","(deg/s) ","(deg/s) ","(deg/s) "/) ! Initialize values @@ -4509,19 +4543,15 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) END IF ! ................. End of validity checking ................. - !------------------------------------------------------------------------------------------------- ! Allocate and set index, name, and units for the output channels ! If a selected output channel is not available in this module, set error flag. !------------------------------------------------------------------------------------------------- - ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat ) - IF ( ErrStat /= 0_IntKi ) THEN - ErrStat = ErrID_Fatal - ErrMsg = "SetOutParam:Error allocating memory for the ElastoDyn OutParam array." + ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) RETURN - ELSE - ErrStat = ErrID_None ENDIF ! Set index, name, and units for the time output channel: @@ -4585,8 +4615,7 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) p%OutParam(I)%Units = "INVALID" p%OutParam(I)%SignM = 0 ! multiply all results by zero - ErrStat = ErrID_Fatal - ErrMsg = "SetOutParam:"//trim(p%OutParam(I)%Name)//" is not an available output channel. "//TRIM(ErrMsg) + CALL SetErrStat(ErrID_Fatal, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) END IF END DO @@ -5297,7 +5326,7 @@ SUBROUTINE InitBlDefl ( p, InputFileData, InitQF1, InitQF2, InitQE1, ErrStat, Er REAL(ReKi), INTENT(OUT) :: InitQF2(p%NumBl) !< Initial flap deflection for mode 2 (output). INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - CHARACTER(1024), INTENT(OUT) :: ErrMsg !< Error message when ErrStat =/ ErrID_None + CHARACTER(ErrMsgLen), INTENT(OUT) :: ErrMsg !< Error message when ErrStat =/ ErrID_None ! Local variables: @@ -6912,9 +6941,9 @@ SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) + p%TwistedSF(K,1,2,J,1)*CoordSys%j2(K,:) RtHSdat%PAngVelEM(K,J,DOF_BE(K,1),0,:) = - p%TwistedSF(K,2,3,J,1)*CoordSys%j1(K,:) & + p%TwistedSF(K,1,3,J,1)*CoordSys%j2(K,:) - AngVelHM = RtHSdat%AngVelEH + x%QDT(DOF_BF(K,1))*RtHSdat%PAngVelEM(K,J,DOF_BF(K,1),0,:) & - + x%QDT(DOF_BF(K,2))*RtHSdat%PAngVelEM(K,J,DOF_BF(K,2),0,:) & - + x%QDT(DOF_BE(K,1))*RtHSdat%PAngVelEM(K,J,DOF_BE(K,1),0,:) + AngVelHM = x%QDT(DOF_BF(K,1))*RtHSdat%PAngVelEM(K,J,DOF_BF(K,1),0,:) & + + x%QDT(DOF_BF(K,2))*RtHSdat%PAngVelEM(K,J,DOF_BF(K,2),0,:) & + + x%QDT(DOF_BE(K,1))*RtHSdat%PAngVelEM(K,J,DOF_BE(K,1),0,:) RtHSdat%AngVelEM(:,J,K ) = RtHSdat%AngVelEH + AngVelHM RtHSdat%AngPosHM(:,K,J ) = x%QT (DOF_BF(K,1))*RtHSdat%PAngVelEM(K,J,DOF_BF(K,1),0,:) & + x%QT (DOF_BF(K,2))*RtHSdat%PAngVelEM(K,J,DOF_BF(K,2),0,:) & @@ -8529,6 +8558,7 @@ END SUBROUTINE FillAugMat !> This routine allocates the arrays and meshes stored in the ED_OutputType data structure (y), based on the parameters (p). !! Inputs (u) are included only so that output meshes can be siblings of the inputs. !! The routine assumes that the arrays/meshes are not currently allocated (It will produce a fatal error otherwise.) +!! Also note that this must be called after init_u() so that the misc variables that contain the orientations are set. SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -8546,7 +8576,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) INTEGER(IntKi) :: NodeNum ! node number INTEGER(IntKi) :: J, K ! loop counters INTEGER(IntKi) :: ErrStat2 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg2 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message (ErrMsg) ! initialize variables: @@ -8555,7 +8585,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) ErrMsg = "" - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) + CALL AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -8604,7 +8634,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) IF (ErrStat >= AbortErrLev) RETURN ! Use orientation at node 1 for the blade root - CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1) ) + CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1), ref=.true. ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -8614,6 +8644,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) DO J = 0,p%TipNode,p%TipNode if (j==0) then ! blade root NodeNum = p%BldNodes + 2 + y%BladeLn2Mesh(K)%RefNode = NodeNum elseif (j==p%TipNode) then ! blade tip NodeNum = p%BldNodes + 1 end if @@ -8731,7 +8762,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN - CALL MeshPositionNode ( y%TowerLn2Mesh, p%TwrNodes + 2, (/0.0_ReKi, 0.0_ReKi, p%TowerBsHt /), ErrStat2, ErrMsg2 ) + CALL MeshPositionNode ( y%TowerLn2Mesh, p%TwrNodes + 2, (/0.0_ReKi, 0.0_ReKi, p%TowerBsHt /), ErrStat2, ErrMsg2, ref=.true. ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN @@ -9617,7 +9648,7 @@ SUBROUTINE ExitThisRoutine() ! local variables INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) CALL ED_DestroyContState( xdot, ErrStat3, ErrMsg3 ) @@ -9795,7 +9826,7 @@ SUBROUTINE ExitThisRoutine() ! local variables INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) CALL ED_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) @@ -9958,7 +9989,7 @@ SUBROUTINE ExitThisRoutine() ! local variables INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) CALL ED_DestroyContState( xdot_pred, ErrStat3, ErrMsg3 ) @@ -10226,6 +10257,19 @@ SUBROUTINE ED_PrintSum( p, OtherState, GenerateAdamsModel, ErrStat, ErrMsg ) WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO + IF (.not. p%BD4Blades) THEN + WRITE (UnSu,'(2x,A)') + WRITE (UnSu,'(2x,A)') + WRITE (UnSu,'(2x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,OutPFmtS) "Col", TitleStr + WRITE (UnSu,OutPFmtS) "---", TitleStrLines + !WRITE (UnSu,'(2x,A)') 'Col Parameter Units' + !WRITE (UnSu,'(2x,A)') '---- -------------- ----------' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO + ENDIF + CLOSE(UnSu) RETURN @@ -10792,7 +10836,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! allocate dXdu if necessary + ! allocate dXdx if necessary if (.not. allocated(dXdx)) then call AllocAry(dXdx, p%DOFs%NActvDOF * 2, p%DOFs%NActvDOF * 2, 'dXdx', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -11051,7 +11095,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, and RotationVel at each node + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node + 3 & ! Yaw, YawRate, and HSS_Spd - + p%NumOuts ! WriteOutput values + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values do i=1,p%NumBl p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade @@ -11095,7 +11139,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+index_next) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do @@ -11156,6 +11200,10 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y(i+index_next) = AllOut( p%OutParam(i)%Indx ) end do + do i=1, p%BldNd_TotNumOuts + InitOut%RotFrame_y(i+p%NumOuts+index_next) = .true. + end do + deallocate(AllOut) @@ -11185,8 +11233,12 @@ SUBROUTINE ED_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) call allocAry(p%dx, p%NDof, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry(InitOut%LinNames_x, p%DOFs%NActvDOF*2, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry(InitOut%RotFrame_x, p%DOFs%NActvDOF*2, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(InitOut%DerivOrder_x, p%DOFs%NActvDOF*2, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + ! All Elastodyn continuous states are max order = 2 + if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 2 + p%dx = 0.0_R8Ki ! initialize in case we have only 1 blade ! set perturbation sizes: p%dx @@ -11512,9 +11564,9 @@ SUBROUTINE ED_Perturb_u( p, n, perturb_sign, u, du ) CASE (12) !Module/Mesh/Field: u%HubPtLoad%Moment = 12 u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign - CASE (13) !Module/Mesh/Field: u%HubPtLoad%Force = 13 + CASE (13) !Module/Mesh/Field: u%NacelleLoads%Force = 13 u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%HubPtLoad%Moment = 14 + CASE (14) !Module/Mesh/Field: u%NacelleLoads%Moment = 14 u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign CASE (15) !Module/Mesh/Field: u%BlPitchCom = 15 @@ -11599,7 +11651,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) dY(indx_first) = y_p%HSS_Spd - y_m%HSS_Spd; indx_first = indx_first + 1 !indx_last = indx_first + p%NumOuts - 1 - do k=1,p%NumOuts + do k=1,p%NumOuts + p%BldNd_TotNumOuts dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) end do @@ -11608,7 +11660,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) END SUBROUTINE Compute_dY !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedLogMap ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -11627,6 +11679,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, 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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedLogMap !< whether a y_op values should contain log maps instead of full orientation matrices @@ -11635,6 +11688,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' + LOGICAL :: ReturnLogMap TYPE(ED_ContinuousStateType) :: dx !< derivative of continuous states at operating point LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing @@ -11685,6 +11739,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, !.................................. IF ( PRESENT( y_op ) ) THEN + if (present(NeedLogMap)) then + ReturnLogMap = NeedLogMap + else + ReturnLogMap = .false. + end if if (.not. allocated(y_op)) then ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do @@ -11717,22 +11776,22 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, index = 1 if (allocated(y%BladeLn2Mesh)) then do k=1,p%NumBl - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index) + call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, UseLogMaps=ReturnLogMap) end do end if - call PackMotionMesh(y%PlatformPtMesh, y_op, index) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index) - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask) + call PackMotionMesh(y%PlatformPtMesh, y_op, index, UseLogMaps=ReturnLogMap) + call PackMotionMesh(y%TowerLn2Mesh, y_op, index, UseLogMaps=ReturnLogMap) + call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, UseLogMaps=ReturnLogMap) do k=1,p%NumBl - call PackMotionMesh(y%BladeRootMotion(k), y_op, index) + call PackMotionMesh(y%BladeRootMotion(k), y_op, index, UseLogMaps=ReturnLogMap) end do - call PackMotionMesh(y%NacelleMotion, y_op, index) + call PackMotionMesh(y%NacelleMotion, y_op, index, UseLogMaps=ReturnLogMap) y_op(index) = y%Yaw ; index = index + 1 y_op(index) = y%YawRate ; index = index + 1 y_op(index) = y%HSS_Spd - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do diff --git a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 new file mode 100644 index 0000000000..91c2ed0669 --- /dev/null +++ b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 @@ -0,0 +1,665 @@ +! This module is an add on to ElastoDyn to allow output of blade structural data at each blade node when BeamDyn is not used +! +! Copyright 2016 Envision Energy +! + +MODULE ElastoDyn_AllBldNdOuts_IO + + USE NWTC_Library + USE ElastoDyn_Types + + IMPLICIT NONE + + PRIVATE + + + PUBLIC :: AllBldNdOuts_InitOut + PUBLIC :: Calc_WriteAllBldNdOutput + PUBLIC :: AllBldNdOuts_SetParameters + + + ! 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 + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 14-Dec-2017 10:34:30. + + + ! Indices for computing output channels: + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter + + + ! Local Span Motions: + + INTEGER(IntKi), PARAMETER :: BldNd_ALx = 1 + INTEGER(IntKi), PARAMETER :: BldNd_ALy = 2 + INTEGER(IntKi), PARAMETER :: BldNd_ALz = 3 + INTEGER(IntKi), PARAMETER :: BldNd_TDx = 4 + INTEGER(IntKi), PARAMETER :: BldNd_TDy = 5 + INTEGER(IntKi), PARAMETER :: BldNd_TDz = 6 + INTEGER(IntKi), PARAMETER :: BldNd_RDx = 7 + INTEGER(IntKi), PARAMETER :: BldNd_RDy = 8 + INTEGER(IntKi), PARAMETER :: BldNd_RDz = 9 + + + ! Local Span Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_MLx = 10 + INTEGER(IntKi), PARAMETER :: BldNd_MLy = 11 + INTEGER(IntKi), PARAMETER :: BldNd_MLz = 12 + INTEGER(IntKi), PARAMETER :: BldNd_FLx = 13 + INTEGER(IntKi), PARAMETER :: BldNd_FLy = 14 + INTEGER(IntKi), PARAMETER :: BldNd_FLz = 15 + INTEGER(IntKi), PARAMETER :: BldNd_MLxNT = 16 + INTEGER(IntKi), PARAMETER :: BldNd_MlyNT = 17 + INTEGER(IntKi), PARAMETER :: BldNd_FLxNT = 18 + INTEGER(IntKi), PARAMETER :: BldNd_FlyNT = 19 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 19 + +!End of code generated by Matlab script +! =================================================================================================== + + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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, ErrStat, ErrMsg ) + + + TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(ED_ParameterType), INTENT(IN ) :: p ! The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(62) :: ChanPrefix ! Name prefix (B#N###) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + ! First set a counter so we know where in the output array we are in + ! NOTE: we populate invalid names as well (some names are not valid outputs for certain configurations). That means we will have zeros in those values. + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal ElastoDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + ! Populate the header and unit lines for all blades and nodes +#ifndef OUTPUT_CHANNEL_NAMES_AS_DISTANCE + ! ! Warn if we will run into issues with more than 999 nodes. + IF (p%BldNodes > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + ! Populate the header an unit lines for all blades and nodes + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + + ! 3 digit node number + WRITE (TmpChar,'(I3.3)') IdxNode + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(p%BldNd_OutParam(IdxChan)%Name) + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + ENDDO + + END DO + END DO + +#else + ! output format the name of the channel with the distance in cm from the root of the blade instead of by node number. + + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + + ! Node defined by distance along blade + WRITE (TmpChar,'(I6.6)') NINT( 1000.0_ReKi * p%RNodes( IdxNode ) ) + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // '_Z' // TRIM(TmpChar) //'_' + + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(p%BldNd_OutParam(IdxChan)%Name) + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + ENDDO + + ENDDO + ENDDO + +#endif + + +END SUBROUTINE AllBldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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 Calc_WriteAllBldNdOutput( p, u, m, y, LinAccES, ErrStat, ErrMsg ) + TYPE(ED_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(ED_InputType), INTENT(IN ) :: u ! inputs + TYPE(ED_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(ED_OutputType), INTENT(INOUT) :: y ! outputs + REAL(ReKi), INTENT(IN ) :: LinAccES(:,0:,:) ! Total linear acceleration of a point on a blade (point S) in the inertia frame (body E for earth). NOTE: zero index start. + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + + INTEGER(IntKi) :: OutIdx ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: J ! Generic counter for moment and force summation + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(5) :: ChanPrefix ! Name prefix ( B#N### or B#D#### ) + CHARACTER(2) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' +! REAL(ReKi) :: ct, st ! cosine, sine of theta +! REAL(ReKi) :: cp, sp ! cosine, sine of phi +! REAL(ReKi) :: Tmp(3) + REAL(ReKi) :: OutVal ! Temporary variable to hold the value to output to the channel. + + ! Variables used in the CalcOutput routine that are needed here for coordinate transforms + REAL(R8Ki) :: rSPS (3) ! Position vector from the undeflected blade node (point S prime) to the deflected node (point S) + REAL(R8Ki) :: TmpVec (3) ! A temporary vector used in various computations. + REAL(R8Ki) :: TmpVec2 (3) ! A temporary vector. + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + OutIdx = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal ElastoDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (0) ! Invalid channel + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j1(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j2(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j3(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j1(IdxBlade,:) )*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j2(IdxBlade,:) )*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDz ) ! See note in ElastoDyn.f90 + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + ! y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j3(IdxBlade,:) )*R2D ! this is always zero for FAST + y%WriteOutput( OutIdx ) = 0.0_Reki + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Output blade loads in the blade coordinate system. + CASE ( BldNd_FLxNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), CoordSysNT1() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLyNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), CoordSysNT2() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLxNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), CoordSysNT1() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLyNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), CoordSysNT2() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE DEFAULT + CALL SetErrStat( ErrID_Severe, "Coding error. Output channel not properly set.",ErrStat,ErrMsg,RoutineName ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + + END SELECT + END DO + +contains +function CoordSysNT1() + REAL(ReKi) :: CoordSysNT1 (3) ! A temporary matrix for removing the structural twist from the local output forces and moments, dimension 1 + ! removed + CoordSysNT1(:) = p%CThetaS(IdxBlade,IdxNode)*m%CoordSys%n1(IdxBlade,IdxNode,:) + p%SThetaS(IdxBlade,IdxNode)*m%CoordSys%n2(IdxBlade,IdxNode,:) + +end function CoordSysNT1 + +function CoordSysNT2() + REAL(ReKi) :: CoordSysNT2 (3) ! A temporary matrix for removing the structural twist from the local output forces and moments, dimension 2 + + CoordSysNT2(:) = -p%SThetaS(IdxBlade,IdxNode)*m%CoordSys%n1(IdxBlade,IdxNode,:) + p%CThetaS(IdxBlade,IdxNode)*m%CoordSys%n2(IdxBlade,IdxNode,:) + +end function CoordSysNT2 + + +function FrcMGagB() + REAL(R8Ki) :: FrcMGagB (3) ! Total force at the blade element (body M) / blade strain gage location (point S) due to the blade above the strain gage. + + ! Initialize FrcMGagB using the tip brake effects: + + FrcMGagB = m%RtHS%FSTipDrag(:,IdxBlade) - p%TipMass(IdxBlade)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,p%TipNode,IdxBlade) ) + + ! Integrate to find FrcMGagB and MomMGagB using all of the nodes / elements above the current strain gage location: + DO J = ( IdxNode + 1 ),p%BldNodes ! Loop through blade nodes / elements above strain gage node + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,J) - p%MassB(IdxBlade,J)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,J,IdxBlade) ) ! Portion of FrcMGagB associated with element J + FrcMGagB = FrcMGagB + TmpVec2*p%DRNodes(J) + + ENDDO ! J - Blade nodes / elements above strain gage node + + ! Add the effects of 1/2 the strain gage element: + ! NOTE: for the radius in this calculation, assume that there is no + ! shortening effect (due to blade bending) within the element. Thus, + ! the moment arm for the force is 1/4 of p%DRNodes() and the element + ! length is 1/2 of p%DRNodes(). + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,IdxNode) - p%MassB(IdxBlade,IdxNode)* ( p%Gravity*m%CoordSys%z2 + LinAccES(:,IdxNode,IdxBlade) ) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + FrcMGagB = FrcMGagB + TmpVec2 * 0.5 * p%DRNodes(IdxNode) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + FrcMGagB = 0.001*FrcMGagB ! Convert the local force to kN + +end function FrcMGagB + +function MomMGagB() + REAL(ReKi) :: MomMGagB (3) ! Total moment at the blade element (body M) / blade strain gage location (point S) due to the blade above the strain gage. + + ! Initialize MomMGagB using the tip brake effects: + + TmpVec2 = m%RtHS%FSTipDrag(:,IdxBlade) - p%TipMass(IdxBlade)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,p%TipNode,IdxBlade) ) ! Portion of FrcMGagB + MomMGagB = CROSS_PRODUCT( m%RtHS%rS0S(:,IdxBlade,p%TipNode) - m%RtHS%rS0S(:,IdxBlade,IdxNode), TmpVec2 ) + + ! Integrate to find FrcMGagB and MomMGagB using all of the nodes / elements above the current strain gage location: + DO J = ( IdxNode + 1 ),p%BldNodes ! Loop through blade nodes / elements above strain gage node + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,J) - p%MassB(IdxBlade,J)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,J,IdxBlade) ) ! Portion of FrcMGagB associated with element J + TmpVec = CROSS_PRODUCT( m%RtHS%rS0S(:,IdxBlade,J) - m%RtHS%rS0S(:,IdxBlade,IdxNode), TmpVec2 ) ! Portion of MomMGagB associated with element J + MomMGagB = MomMGagB + ( TmpVec + m%RtHS%MMAero(:,IdxBlade,J) )*p%DRNodes(J) + + ENDDO ! J - Blade nodes / elements above strain gage node + + ! Add the effects of 1/2 the strain gage element: + ! NOTE: for the radius in this calculation, assume that there is no + ! shortening effect (due to blade bending) within the element. Thus, + ! the moment arm for the force is 1/4 of p%DRNodes() and the element + ! length is 1/2 of p%DRNodes(). + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,IdxNode) - p%MassB(IdxBlade,IdxNode)* ( p%Gravity*m%CoordSys%z2 + LinAccES(:,IdxNode,IdxBlade) ) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + TmpVec = CROSS_PRODUCT( ( 0.25_R8Ki*p%DRNodes(IdxNode) )*m%CoordSys%j3(IdxBlade,:), TmpVec2 ) ! Portion of MomMGagB associated with 1/2 of the strain gage element + + MomMGagB = MomMGagB + ( TmpVec + m%RtHS%MMAero(:,IdxBlade,IdxNode) )* ( 0.5 *p%DRNodes(IdxNode) ) + MomMGagB = 0.001*MomMGagB ! Convert the local moment to kN-m + +end function MomMGagB + +END SUBROUTINE Calc_WriteAllBldNdOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates and sets the parameters for the nodal outputs. +SUBROUTINE AllBldNdOuts_SetParameters( p, InputFileData, ErrStat, ErrMsg ) +!.................................................................................................................................. + + + ! Passed variables: + + TYPE(ED_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + integer(IntKi) :: k ! Blade number + integer(IntKi) :: j ! node number + character(*), parameter :: RoutineName = 'AllBldNdOuts_ValidateInputData' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Check if the requested blades exist + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBl) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all bladed nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBl))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = 0_IntKi + ELSE + p%BldNd_BladesOut = InputFileData%BldNd_BladesOut + ENDIF + + + ! Check if the requested blade nodes are valid + ! InputFileData%BldNd_BlOutNd + + + + ! Set the parameter to store number of requested Blade Node output sets + IF ( p%BD4Blades .and. InputFileData%BldNd_NumOuts > 0 ) THEN + p%BldNd_BladesOut = 0_IntKi + p%BldNd_NumOuts = 0_IntKi + CALL SetErrStat( ErrID_Warn,' AllBldNdOuts option not available in ElastoDyn when BeamDyn is used. Turning off these outputs.',ErrStat,ErrMsg,"SetPrimaryParameters" ) + ELSE + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + ENDIF + + ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) + p%BldNd_TotNumOuts = p%BldNodes*p%BldNd_BladesOut*p%BldNd_NumOuts !p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) + +! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd +! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes +! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) +! ! -- copy values over +! +! ! Temporary workaround here: +! ALLOCATE ( p%BldNd_BlOutNd(1:p%BldNodes) , STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%BldNodes ! put all nodes in the list +! p%BldNd_BlOutNd(i) = i +! ENDDO + + +! ! Check if the requested blades are actually in use: +! ! TODO: this value is not read in by the input file reading yet, so setting to all blades +! ! -- check if list handed in is of blades that exist (not sure this is ever checked) +! ! -- copy values over +! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBl), STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBl ! put all blades in the list +! p%BldNd_BladesOut(i) = i +! ENDDO + + if (p%BldNd_TotNumOuts > 0) then + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + end if + + +END SUBROUTINE AllBldNdOuts_SetParameters + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 14-Dec-2017 10:34:30. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + 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(42) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ALX ","ALY ","ALZ ","AX ","AY ","AZ ","FLX ","FLXNT","FLY ","FLYNT", & + "FLZ ","FLZNT","FX ","FXL ","FY ","FYL ","FZ ","FZL ","MLX ","MLXNT", & + "MLY ","MLYNT","MLZ ","MLZNT","MX ","MXL ","MY ","MYL ","MZ ","MZL ", & + "RDX ","RDY ","RDZ ","RX ","RY ","RZ ","TDX ","TDY ","TDZ ","UXB ", & + "UYB ","UZB "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(42) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_ALx , BldNd_ALy , BldNd_ALz , BldNd_ALx , BldNd_ALy , BldNd_ALz , BldNd_FLx , BldNd_FLxNT , BldNd_FLy , BldNd_FlyNT , & + BldNd_FLz , BldNd_FLz , BldNd_FLx , BldNd_FLxNT , BldNd_FLy , BldNd_FlyNT , BldNd_FLz , BldNd_FLz , BldNd_MLx , BldNd_MLxNT , & + BldNd_MLy , BldNd_MlyNT , BldNd_MLz , BldNd_MLz , BldNd_MLx , BldNd_MLxNT , BldNd_MLy , BldNd_MlyNT , BldNd_MLz , BldNd_MLz , & + BldNd_RDx , BldNd_RDy , BldNd_RDz , BldNd_RDx , BldNd_RDy , BldNd_RDz , BldNd_TDx , BldNd_TDy , BldNd_TDz , BldNd_TDx , & + BldNd_TDy , BldNd_TDz /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(42) = (/ & ! This lists the units corresponding to the allowed parameters + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%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 = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE ElastoDyn_AllBldNdOuts_IO diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 8222a52495..d097d0801b 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -26,6 +26,8 @@ MODULE ElastoDyn_Parameters USE NWTC_Library + USE ElastoDyn_AllBldNdOuts_IO + TYPE(ProgDesc), PARAMETER :: ED_Ver = ProgDesc( 'ElastoDyn', '', '' ) REAL(ReKi), PARAMETER :: SmallAngleLimit_Deg = 15.0 ! Largest input angle considered "small" (used as a check on input data), degrees @@ -61,7 +63,7 @@ MODULE ElastoDyn_Parameters INTEGER(IntKi), PARAMETER :: DOF_Teet = 22 !DOF_TFrl + 2*(NumBE+NumBF)+ 1 ! DOF index for rotor-teeter - + INTEGER(IntKi), PARAMETER :: ED_MaxDOFs = 24 INTEGER(IntKi), PARAMETER :: NPA = 9 ! Number of DOFs that contribute to the angular velocity of the tail (body A) in the inertia frame. @@ -99,7 +101,7 @@ MODULE ElastoDyn_Parameters ! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these ! lines should be modified in the Matlab script and/or Excel worksheet as necessary. ! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 02-Mar-2015 10:37:31. +! This code was generated by Write_ChckOutLst.m at 08-Jun-2020 13:26:29. ! Parameters related to output length (number of characters allowed in the output data headers): @@ -110,7 +112,7 @@ MODULE ElastoDyn_Parameters ! Indices for computing output channels: ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array y%AllOuts() must be dimensioned to the value of the largest output parameter + ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter ! Time: @@ -485,621 +487,624 @@ MODULE ElastoDyn_Parameters ! Tower-Top / Yaw Bearing Motions: - INTEGER(IntKi), PARAMETER :: YawBrTDxp = 315 - INTEGER(IntKi), PARAMETER :: YawBrTDyp = 316 - INTEGER(IntKi), PARAMETER :: YawBrTDzp = 317 - INTEGER(IntKi), PARAMETER :: YawBrTDxt = 318 - INTEGER(IntKi), PARAMETER :: YawBrTDyt = 319 - INTEGER(IntKi), PARAMETER :: YawBrTDzt = 320 - INTEGER(IntKi), PARAMETER :: YawBrTAxp = 321 - INTEGER(IntKi), PARAMETER :: YawBrTAyp = 322 - INTEGER(IntKi), PARAMETER :: YawBrTAzp = 323 - INTEGER(IntKi), PARAMETER :: YawBrRDxt = 324 - INTEGER(IntKi), PARAMETER :: YawBrRDyt = 325 - INTEGER(IntKi), PARAMETER :: YawBrRDzt = 326 - INTEGER(IntKi), PARAMETER :: YawBrRVxp = 327 - INTEGER(IntKi), PARAMETER :: YawBrRVyp = 328 - INTEGER(IntKi), PARAMETER :: YawBrRVzp = 329 - INTEGER(IntKi), PARAMETER :: YawBrRAxp = 330 - INTEGER(IntKi), PARAMETER :: YawBrRAyp = 331 - INTEGER(IntKi), PARAMETER :: YawBrRAzp = 332 + INTEGER(IntKi), PARAMETER :: TwrTpTDxi = 315 + INTEGER(IntKi), PARAMETER :: TwrTpTDyi = 316 + INTEGER(IntKi), PARAMETER :: TwrTpTDzi = 317 + INTEGER(IntKi), PARAMETER :: YawBrTDxp = 318 + INTEGER(IntKi), PARAMETER :: YawBrTDyp = 319 + INTEGER(IntKi), PARAMETER :: YawBrTDzp = 320 + INTEGER(IntKi), PARAMETER :: YawBrTDxt = 321 + INTEGER(IntKi), PARAMETER :: YawBrTDyt = 322 + INTEGER(IntKi), PARAMETER :: YawBrTDzt = 323 + INTEGER(IntKi), PARAMETER :: YawBrTAxp = 324 + INTEGER(IntKi), PARAMETER :: YawBrTAyp = 325 + INTEGER(IntKi), PARAMETER :: YawBrTAzp = 326 + INTEGER(IntKi), PARAMETER :: YawBrRDxt = 327 + INTEGER(IntKi), PARAMETER :: YawBrRDyt = 328 + INTEGER(IntKi), PARAMETER :: YawBrRDzt = 329 + INTEGER(IntKi), PARAMETER :: YawBrRVxp = 330 + INTEGER(IntKi), PARAMETER :: YawBrRVyp = 331 + INTEGER(IntKi), PARAMETER :: YawBrRVzp = 332 + INTEGER(IntKi), PARAMETER :: YawBrRAxp = 333 + INTEGER(IntKi), PARAMETER :: YawBrRAyp = 334 + INTEGER(IntKi), PARAMETER :: YawBrRAzp = 335 ! Local Tower Motions: - INTEGER(IntKi), PARAMETER :: TwHt1ALxt = 333 - INTEGER(IntKi), PARAMETER :: TwHt1ALyt = 334 - INTEGER(IntKi), PARAMETER :: TwHt1ALzt = 335 - INTEGER(IntKi), PARAMETER :: TwHt2ALxt = 336 - INTEGER(IntKi), PARAMETER :: TwHt2ALyt = 337 - INTEGER(IntKi), PARAMETER :: TwHt2ALzt = 338 - INTEGER(IntKi), PARAMETER :: TwHt3ALxt = 339 - INTEGER(IntKi), PARAMETER :: TwHt3ALyt = 340 - INTEGER(IntKi), PARAMETER :: TwHt3ALzt = 341 - INTEGER(IntKi), PARAMETER :: TwHt4ALxt = 342 - INTEGER(IntKi), PARAMETER :: TwHt4ALyt = 343 - INTEGER(IntKi), PARAMETER :: TwHt4ALzt = 344 - INTEGER(IntKi), PARAMETER :: TwHt5ALxt = 345 - INTEGER(IntKi), PARAMETER :: TwHt5ALyt = 346 - INTEGER(IntKi), PARAMETER :: TwHt5ALzt = 347 - INTEGER(IntKi), PARAMETER :: TwHt6ALxt = 348 - INTEGER(IntKi), PARAMETER :: TwHt6ALyt = 349 - INTEGER(IntKi), PARAMETER :: TwHt6ALzt = 350 - INTEGER(IntKi), PARAMETER :: TwHt7ALxt = 351 - INTEGER(IntKi), PARAMETER :: TwHt7ALyt = 352 - INTEGER(IntKi), PARAMETER :: TwHt7ALzt = 353 - INTEGER(IntKi), PARAMETER :: TwHt8ALxt = 354 - INTEGER(IntKi), PARAMETER :: TwHt8ALyt = 355 - INTEGER(IntKi), PARAMETER :: TwHt8ALzt = 356 - INTEGER(IntKi), PARAMETER :: TwHt9ALxt = 357 - INTEGER(IntKi), PARAMETER :: TwHt9ALyt = 358 - INTEGER(IntKi), PARAMETER :: TwHt9ALzt = 359 - INTEGER(IntKi), PARAMETER :: TwHt1TDxt = 360 - INTEGER(IntKi), PARAMETER :: TwHt1TDyt = 361 - INTEGER(IntKi), PARAMETER :: TwHt1TDzt = 362 - INTEGER(IntKi), PARAMETER :: TwHt2TDxt = 363 - INTEGER(IntKi), PARAMETER :: TwHt2TDyt = 364 - INTEGER(IntKi), PARAMETER :: TwHt2TDzt = 365 - INTEGER(IntKi), PARAMETER :: TwHt3TDxt = 366 - INTEGER(IntKi), PARAMETER :: TwHt3TDyt = 367 - INTEGER(IntKi), PARAMETER :: TwHt3TDzt = 368 - INTEGER(IntKi), PARAMETER :: TwHt4TDxt = 369 - INTEGER(IntKi), PARAMETER :: TwHt4TDyt = 370 - INTEGER(IntKi), PARAMETER :: TwHt4TDzt = 371 - INTEGER(IntKi), PARAMETER :: TwHt5TDxt = 372 - INTEGER(IntKi), PARAMETER :: TwHt5TDyt = 373 - INTEGER(IntKi), PARAMETER :: TwHt5TDzt = 374 - INTEGER(IntKi), PARAMETER :: TwHt6TDxt = 375 - INTEGER(IntKi), PARAMETER :: TwHt6TDyt = 376 - INTEGER(IntKi), PARAMETER :: TwHt6TDzt = 377 - INTEGER(IntKi), PARAMETER :: TwHt7TDxt = 378 - INTEGER(IntKi), PARAMETER :: TwHt7TDyt = 379 - INTEGER(IntKi), PARAMETER :: TwHt7TDzt = 380 - INTEGER(IntKi), PARAMETER :: TwHt8TDxt = 381 - INTEGER(IntKi), PARAMETER :: TwHt8TDyt = 382 - INTEGER(IntKi), PARAMETER :: TwHt8TDzt = 383 - INTEGER(IntKi), PARAMETER :: TwHt9TDxt = 384 - INTEGER(IntKi), PARAMETER :: TwHt9TDyt = 385 - INTEGER(IntKi), PARAMETER :: TwHt9TDzt = 386 - INTEGER(IntKi), PARAMETER :: TwHt1RDxt = 387 - INTEGER(IntKi), PARAMETER :: TwHt1RDyt = 388 - INTEGER(IntKi), PARAMETER :: TwHt1RDzt = 389 - INTEGER(IntKi), PARAMETER :: TwHt2RDxt = 390 - INTEGER(IntKi), PARAMETER :: TwHt2RDyt = 391 - INTEGER(IntKi), PARAMETER :: TwHt2RDzt = 392 - INTEGER(IntKi), PARAMETER :: TwHt3RDxt = 393 - INTEGER(IntKi), PARAMETER :: TwHt3RDyt = 394 - INTEGER(IntKi), PARAMETER :: TwHt3RDzt = 395 - INTEGER(IntKi), PARAMETER :: TwHt4RDxt = 396 - INTEGER(IntKi), PARAMETER :: TwHt4RDyt = 397 - INTEGER(IntKi), PARAMETER :: TwHt4RDzt = 398 - INTEGER(IntKi), PARAMETER :: TwHt5RDxt = 399 - INTEGER(IntKi), PARAMETER :: TwHt5RDyt = 400 - INTEGER(IntKi), PARAMETER :: TwHt5RDzt = 401 - INTEGER(IntKi), PARAMETER :: TwHt6RDxt = 402 - INTEGER(IntKi), PARAMETER :: TwHt6RDyt = 403 - INTEGER(IntKi), PARAMETER :: TwHt6RDzt = 404 - INTEGER(IntKi), PARAMETER :: TwHt7RDxt = 405 - INTEGER(IntKi), PARAMETER :: TwHt7RDyt = 406 - INTEGER(IntKi), PARAMETER :: TwHt7RDzt = 407 - INTEGER(IntKi), PARAMETER :: TwHt8RDxt = 408 - INTEGER(IntKi), PARAMETER :: TwHt8RDyt = 409 - INTEGER(IntKi), PARAMETER :: TwHt8RDzt = 410 - INTEGER(IntKi), PARAMETER :: TwHt9RDxt = 411 - INTEGER(IntKi), PARAMETER :: TwHt9RDyt = 412 - INTEGER(IntKi), PARAMETER :: TwHt9RDzt = 413 - INTEGER(IntKi), PARAMETER :: TwHt1TPxi = 414 - INTEGER(IntKi), PARAMETER :: TwHt1TPyi = 415 - INTEGER(IntKi), PARAMETER :: TwHt1TPzi = 416 - INTEGER(IntKi), PARAMETER :: TwHt2TPxi = 417 - INTEGER(IntKi), PARAMETER :: TwHt2TPyi = 418 - INTEGER(IntKi), PARAMETER :: TwHt2TPzi = 419 - INTEGER(IntKi), PARAMETER :: TwHt3TPxi = 420 - INTEGER(IntKi), PARAMETER :: TwHt3TPyi = 421 - INTEGER(IntKi), PARAMETER :: TwHt3TPzi = 422 - INTEGER(IntKi), PARAMETER :: TwHt4TPxi = 423 - INTEGER(IntKi), PARAMETER :: TwHt4TPyi = 424 - INTEGER(IntKi), PARAMETER :: TwHt4TPzi = 425 - INTEGER(IntKi), PARAMETER :: TwHt5TPxi = 426 - INTEGER(IntKi), PARAMETER :: TwHt5TPyi = 427 - INTEGER(IntKi), PARAMETER :: TwHt5TPzi = 428 - INTEGER(IntKi), PARAMETER :: TwHt6TPxi = 429 - INTEGER(IntKi), PARAMETER :: TwHt6TPyi = 430 - INTEGER(IntKi), PARAMETER :: TwHt6TPzi = 431 - INTEGER(IntKi), PARAMETER :: TwHt7TPxi = 432 - INTEGER(IntKi), PARAMETER :: TwHt7TPyi = 433 - INTEGER(IntKi), PARAMETER :: TwHt7TPzi = 434 - INTEGER(IntKi), PARAMETER :: TwHt8TPxi = 435 - INTEGER(IntKi), PARAMETER :: TwHt8TPyi = 436 - INTEGER(IntKi), PARAMETER :: TwHt8TPzi = 437 - INTEGER(IntKi), PARAMETER :: TwHt9TPxi = 438 - INTEGER(IntKi), PARAMETER :: TwHt9TPyi = 439 - INTEGER(IntKi), PARAMETER :: TwHt9TPzi = 440 - INTEGER(IntKi), PARAMETER :: TwHt1RPxi = 441 - INTEGER(IntKi), PARAMETER :: TwHt1RPyi = 442 - INTEGER(IntKi), PARAMETER :: TwHt1RPzi = 443 - INTEGER(IntKi), PARAMETER :: TwHt2RPxi = 444 - INTEGER(IntKi), PARAMETER :: TwHt2RPyi = 445 - INTEGER(IntKi), PARAMETER :: TwHt2RPzi = 446 - INTEGER(IntKi), PARAMETER :: TwHt3RPxi = 447 - INTEGER(IntKi), PARAMETER :: TwHt3RPyi = 448 - INTEGER(IntKi), PARAMETER :: TwHt3RPzi = 449 - INTEGER(IntKi), PARAMETER :: TwHt4RPxi = 450 - INTEGER(IntKi), PARAMETER :: TwHt4RPyi = 451 - INTEGER(IntKi), PARAMETER :: TwHt4RPzi = 452 - INTEGER(IntKi), PARAMETER :: TwHt5RPxi = 453 - INTEGER(IntKi), PARAMETER :: TwHt5RPyi = 454 - INTEGER(IntKi), PARAMETER :: TwHt5RPzi = 455 - INTEGER(IntKi), PARAMETER :: TwHt6RPxi = 456 - INTEGER(IntKi), PARAMETER :: TwHt6RPyi = 457 - INTEGER(IntKi), PARAMETER :: TwHt6RPzi = 458 - INTEGER(IntKi), PARAMETER :: TwHt7RPxi = 459 - INTEGER(IntKi), PARAMETER :: TwHt7RPyi = 460 - INTEGER(IntKi), PARAMETER :: TwHt7RPzi = 461 - INTEGER(IntKi), PARAMETER :: TwHt8RPxi = 462 - INTEGER(IntKi), PARAMETER :: TwHt8RPyi = 463 - INTEGER(IntKi), PARAMETER :: TwHt8RPzi = 464 - INTEGER(IntKi), PARAMETER :: TwHt9RPxi = 465 - INTEGER(IntKi), PARAMETER :: TwHt9RPyi = 466 - INTEGER(IntKi), PARAMETER :: TwHt9RPzi = 467 + INTEGER(IntKi), PARAMETER :: TwHt1ALxt = 336 + INTEGER(IntKi), PARAMETER :: TwHt1ALyt = 337 + INTEGER(IntKi), PARAMETER :: TwHt1ALzt = 338 + INTEGER(IntKi), PARAMETER :: TwHt2ALxt = 339 + INTEGER(IntKi), PARAMETER :: TwHt2ALyt = 340 + INTEGER(IntKi), PARAMETER :: TwHt2ALzt = 341 + INTEGER(IntKi), PARAMETER :: TwHt3ALxt = 342 + INTEGER(IntKi), PARAMETER :: TwHt3ALyt = 343 + INTEGER(IntKi), PARAMETER :: TwHt3ALzt = 344 + INTEGER(IntKi), PARAMETER :: TwHt4ALxt = 345 + INTEGER(IntKi), PARAMETER :: TwHt4ALyt = 346 + INTEGER(IntKi), PARAMETER :: TwHt4ALzt = 347 + INTEGER(IntKi), PARAMETER :: TwHt5ALxt = 348 + INTEGER(IntKi), PARAMETER :: TwHt5ALyt = 349 + INTEGER(IntKi), PARAMETER :: TwHt5ALzt = 350 + INTEGER(IntKi), PARAMETER :: TwHt6ALxt = 351 + INTEGER(IntKi), PARAMETER :: TwHt6ALyt = 352 + INTEGER(IntKi), PARAMETER :: TwHt6ALzt = 353 + INTEGER(IntKi), PARAMETER :: TwHt7ALxt = 354 + INTEGER(IntKi), PARAMETER :: TwHt7ALyt = 355 + INTEGER(IntKi), PARAMETER :: TwHt7ALzt = 356 + INTEGER(IntKi), PARAMETER :: TwHt8ALxt = 357 + INTEGER(IntKi), PARAMETER :: TwHt8ALyt = 358 + INTEGER(IntKi), PARAMETER :: TwHt8ALzt = 359 + INTEGER(IntKi), PARAMETER :: TwHt9ALxt = 360 + INTEGER(IntKi), PARAMETER :: TwHt9ALyt = 361 + INTEGER(IntKi), PARAMETER :: TwHt9ALzt = 362 + INTEGER(IntKi), PARAMETER :: TwHt1TDxt = 363 + INTEGER(IntKi), PARAMETER :: TwHt1TDyt = 364 + INTEGER(IntKi), PARAMETER :: TwHt1TDzt = 365 + INTEGER(IntKi), PARAMETER :: TwHt2TDxt = 366 + INTEGER(IntKi), PARAMETER :: TwHt2TDyt = 367 + INTEGER(IntKi), PARAMETER :: TwHt2TDzt = 368 + INTEGER(IntKi), PARAMETER :: TwHt3TDxt = 369 + INTEGER(IntKi), PARAMETER :: TwHt3TDyt = 370 + INTEGER(IntKi), PARAMETER :: TwHt3TDzt = 371 + INTEGER(IntKi), PARAMETER :: TwHt4TDxt = 372 + INTEGER(IntKi), PARAMETER :: TwHt4TDyt = 373 + INTEGER(IntKi), PARAMETER :: TwHt4TDzt = 374 + INTEGER(IntKi), PARAMETER :: TwHt5TDxt = 375 + INTEGER(IntKi), PARAMETER :: TwHt5TDyt = 376 + INTEGER(IntKi), PARAMETER :: TwHt5TDzt = 377 + INTEGER(IntKi), PARAMETER :: TwHt6TDxt = 378 + INTEGER(IntKi), PARAMETER :: TwHt6TDyt = 379 + INTEGER(IntKi), PARAMETER :: TwHt6TDzt = 380 + INTEGER(IntKi), PARAMETER :: TwHt7TDxt = 381 + INTEGER(IntKi), PARAMETER :: TwHt7TDyt = 382 + INTEGER(IntKi), PARAMETER :: TwHt7TDzt = 383 + INTEGER(IntKi), PARAMETER :: TwHt8TDxt = 384 + INTEGER(IntKi), PARAMETER :: TwHt8TDyt = 385 + INTEGER(IntKi), PARAMETER :: TwHt8TDzt = 386 + INTEGER(IntKi), PARAMETER :: TwHt9TDxt = 387 + INTEGER(IntKi), PARAMETER :: TwHt9TDyt = 388 + INTEGER(IntKi), PARAMETER :: TwHt9TDzt = 389 + INTEGER(IntKi), PARAMETER :: TwHt1RDxt = 390 + INTEGER(IntKi), PARAMETER :: TwHt1RDyt = 391 + INTEGER(IntKi), PARAMETER :: TwHt1RDzt = 392 + INTEGER(IntKi), PARAMETER :: TwHt2RDxt = 393 + INTEGER(IntKi), PARAMETER :: TwHt2RDyt = 394 + INTEGER(IntKi), PARAMETER :: TwHt2RDzt = 395 + INTEGER(IntKi), PARAMETER :: TwHt3RDxt = 396 + INTEGER(IntKi), PARAMETER :: TwHt3RDyt = 397 + INTEGER(IntKi), PARAMETER :: TwHt3RDzt = 398 + INTEGER(IntKi), PARAMETER :: TwHt4RDxt = 399 + INTEGER(IntKi), PARAMETER :: TwHt4RDyt = 400 + INTEGER(IntKi), PARAMETER :: TwHt4RDzt = 401 + INTEGER(IntKi), PARAMETER :: TwHt5RDxt = 402 + INTEGER(IntKi), PARAMETER :: TwHt5RDyt = 403 + INTEGER(IntKi), PARAMETER :: TwHt5RDzt = 404 + INTEGER(IntKi), PARAMETER :: TwHt6RDxt = 405 + INTEGER(IntKi), PARAMETER :: TwHt6RDyt = 406 + INTEGER(IntKi), PARAMETER :: TwHt6RDzt = 407 + INTEGER(IntKi), PARAMETER :: TwHt7RDxt = 408 + INTEGER(IntKi), PARAMETER :: TwHt7RDyt = 409 + INTEGER(IntKi), PARAMETER :: TwHt7RDzt = 410 + INTEGER(IntKi), PARAMETER :: TwHt8RDxt = 411 + INTEGER(IntKi), PARAMETER :: TwHt8RDyt = 412 + INTEGER(IntKi), PARAMETER :: TwHt8RDzt = 413 + INTEGER(IntKi), PARAMETER :: TwHt9RDxt = 414 + INTEGER(IntKi), PARAMETER :: TwHt9RDyt = 415 + INTEGER(IntKi), PARAMETER :: TwHt9RDzt = 416 + INTEGER(IntKi), PARAMETER :: TwHt1TPxi = 417 + INTEGER(IntKi), PARAMETER :: TwHt1TPyi = 418 + INTEGER(IntKi), PARAMETER :: TwHt1TPzi = 419 + INTEGER(IntKi), PARAMETER :: TwHt2TPxi = 420 + INTEGER(IntKi), PARAMETER :: TwHt2TPyi = 421 + INTEGER(IntKi), PARAMETER :: TwHt2TPzi = 422 + INTEGER(IntKi), PARAMETER :: TwHt3TPxi = 423 + INTEGER(IntKi), PARAMETER :: TwHt3TPyi = 424 + INTEGER(IntKi), PARAMETER :: TwHt3TPzi = 425 + INTEGER(IntKi), PARAMETER :: TwHt4TPxi = 426 + INTEGER(IntKi), PARAMETER :: TwHt4TPyi = 427 + INTEGER(IntKi), PARAMETER :: TwHt4TPzi = 428 + INTEGER(IntKi), PARAMETER :: TwHt5TPxi = 429 + INTEGER(IntKi), PARAMETER :: TwHt5TPyi = 430 + INTEGER(IntKi), PARAMETER :: TwHt5TPzi = 431 + INTEGER(IntKi), PARAMETER :: TwHt6TPxi = 432 + INTEGER(IntKi), PARAMETER :: TwHt6TPyi = 433 + INTEGER(IntKi), PARAMETER :: TwHt6TPzi = 434 + INTEGER(IntKi), PARAMETER :: TwHt7TPxi = 435 + INTEGER(IntKi), PARAMETER :: TwHt7TPyi = 436 + INTEGER(IntKi), PARAMETER :: TwHt7TPzi = 437 + INTEGER(IntKi), PARAMETER :: TwHt8TPxi = 438 + INTEGER(IntKi), PARAMETER :: TwHt8TPyi = 439 + INTEGER(IntKi), PARAMETER :: TwHt8TPzi = 440 + INTEGER(IntKi), PARAMETER :: TwHt9TPxi = 441 + INTEGER(IntKi), PARAMETER :: TwHt9TPyi = 442 + INTEGER(IntKi), PARAMETER :: TwHt9TPzi = 443 + INTEGER(IntKi), PARAMETER :: TwHt1RPxi = 444 + INTEGER(IntKi), PARAMETER :: TwHt1RPyi = 445 + INTEGER(IntKi), PARAMETER :: TwHt1RPzi = 446 + INTEGER(IntKi), PARAMETER :: TwHt2RPxi = 447 + INTEGER(IntKi), PARAMETER :: TwHt2RPyi = 448 + INTEGER(IntKi), PARAMETER :: TwHt2RPzi = 449 + INTEGER(IntKi), PARAMETER :: TwHt3RPxi = 450 + INTEGER(IntKi), PARAMETER :: TwHt3RPyi = 451 + INTEGER(IntKi), PARAMETER :: TwHt3RPzi = 452 + INTEGER(IntKi), PARAMETER :: TwHt4RPxi = 453 + INTEGER(IntKi), PARAMETER :: TwHt4RPyi = 454 + INTEGER(IntKi), PARAMETER :: TwHt4RPzi = 455 + INTEGER(IntKi), PARAMETER :: TwHt5RPxi = 456 + INTEGER(IntKi), PARAMETER :: TwHt5RPyi = 457 + INTEGER(IntKi), PARAMETER :: TwHt5RPzi = 458 + INTEGER(IntKi), PARAMETER :: TwHt6RPxi = 459 + INTEGER(IntKi), PARAMETER :: TwHt6RPyi = 460 + INTEGER(IntKi), PARAMETER :: TwHt6RPzi = 461 + INTEGER(IntKi), PARAMETER :: TwHt7RPxi = 462 + INTEGER(IntKi), PARAMETER :: TwHt7RPyi = 463 + INTEGER(IntKi), PARAMETER :: TwHt7RPzi = 464 + INTEGER(IntKi), PARAMETER :: TwHt8RPxi = 465 + INTEGER(IntKi), PARAMETER :: TwHt8RPyi = 466 + INTEGER(IntKi), PARAMETER :: TwHt8RPzi = 467 + INTEGER(IntKi), PARAMETER :: TwHt9RPxi = 468 + INTEGER(IntKi), PARAMETER :: TwHt9RPyi = 469 + INTEGER(IntKi), PARAMETER :: TwHt9RPzi = 470 ! Platform Motions: - INTEGER(IntKi), PARAMETER :: PtfmTDxt = 468 - INTEGER(IntKi), PARAMETER :: PtfmTDyt = 469 - INTEGER(IntKi), PARAMETER :: PtfmTDzt = 470 - INTEGER(IntKi), PARAMETER :: PtfmTDxi = 471 - INTEGER(IntKi), PARAMETER :: PtfmTDyi = 472 - INTEGER(IntKi), PARAMETER :: PtfmTDzi = 473 - INTEGER(IntKi), PARAMETER :: PtfmTVxt = 474 - INTEGER(IntKi), PARAMETER :: PtfmTVyt = 475 - INTEGER(IntKi), PARAMETER :: PtfmTVzt = 476 - INTEGER(IntKi), PARAMETER :: PtfmTVxi = 477 - INTEGER(IntKi), PARAMETER :: PtfmTVyi = 478 - INTEGER(IntKi), PARAMETER :: PtfmTVzi = 479 - INTEGER(IntKi), PARAMETER :: PtfmTAxt = 480 - INTEGER(IntKi), PARAMETER :: PtfmTAyt = 481 - INTEGER(IntKi), PARAMETER :: PtfmTAzt = 482 - INTEGER(IntKi), PARAMETER :: PtfmTAxi = 483 - INTEGER(IntKi), PARAMETER :: PtfmTAyi = 484 - INTEGER(IntKi), PARAMETER :: PtfmTAzi = 485 - INTEGER(IntKi), PARAMETER :: PtfmRDxi = 486 - INTEGER(IntKi), PARAMETER :: PtfmRDyi = 487 - INTEGER(IntKi), PARAMETER :: PtfmRDzi = 488 - INTEGER(IntKi), PARAMETER :: PtfmRVxt = 489 - INTEGER(IntKi), PARAMETER :: PtfmRVyt = 490 - INTEGER(IntKi), PARAMETER :: PtfmRVzt = 491 - INTEGER(IntKi), PARAMETER :: PtfmRVxi = 492 - INTEGER(IntKi), PARAMETER :: PtfmRVyi = 493 - INTEGER(IntKi), PARAMETER :: PtfmRVzi = 494 - INTEGER(IntKi), PARAMETER :: PtfmRAxt = 495 - INTEGER(IntKi), PARAMETER :: PtfmRAyt = 496 - INTEGER(IntKi), PARAMETER :: PtfmRAzt = 497 - INTEGER(IntKi), PARAMETER :: PtfmRAxi = 498 - INTEGER(IntKi), PARAMETER :: PtfmRAyi = 499 - INTEGER(IntKi), PARAMETER :: PtfmRAzi = 500 + INTEGER(IntKi), PARAMETER :: PtfmTDxt = 471 + INTEGER(IntKi), PARAMETER :: PtfmTDyt = 472 + INTEGER(IntKi), PARAMETER :: PtfmTDzt = 473 + INTEGER(IntKi), PARAMETER :: PtfmTDxi = 474 + INTEGER(IntKi), PARAMETER :: PtfmTDyi = 475 + INTEGER(IntKi), PARAMETER :: PtfmTDzi = 476 + INTEGER(IntKi), PARAMETER :: PtfmTVxt = 477 + INTEGER(IntKi), PARAMETER :: PtfmTVyt = 478 + INTEGER(IntKi), PARAMETER :: PtfmTVzt = 479 + INTEGER(IntKi), PARAMETER :: PtfmTVxi = 480 + INTEGER(IntKi), PARAMETER :: PtfmTVyi = 481 + INTEGER(IntKi), PARAMETER :: PtfmTVzi = 482 + INTEGER(IntKi), PARAMETER :: PtfmTAxt = 483 + INTEGER(IntKi), PARAMETER :: PtfmTAyt = 484 + INTEGER(IntKi), PARAMETER :: PtfmTAzt = 485 + INTEGER(IntKi), PARAMETER :: PtfmTAxi = 486 + INTEGER(IntKi), PARAMETER :: PtfmTAyi = 487 + INTEGER(IntKi), PARAMETER :: PtfmTAzi = 488 + INTEGER(IntKi), PARAMETER :: PtfmRDxi = 489 + INTEGER(IntKi), PARAMETER :: PtfmRDyi = 490 + INTEGER(IntKi), PARAMETER :: PtfmRDzi = 491 + INTEGER(IntKi), PARAMETER :: PtfmRVxt = 492 + INTEGER(IntKi), PARAMETER :: PtfmRVyt = 493 + INTEGER(IntKi), PARAMETER :: PtfmRVzt = 494 + INTEGER(IntKi), PARAMETER :: PtfmRVxi = 495 + INTEGER(IntKi), PARAMETER :: PtfmRVyi = 496 + INTEGER(IntKi), PARAMETER :: PtfmRVzi = 497 + INTEGER(IntKi), PARAMETER :: PtfmRAxt = 498 + INTEGER(IntKi), PARAMETER :: PtfmRAyt = 499 + INTEGER(IntKi), PARAMETER :: PtfmRAzt = 500 + INTEGER(IntKi), PARAMETER :: PtfmRAxi = 501 + INTEGER(IntKi), PARAMETER :: PtfmRAyi = 502 + INTEGER(IntKi), PARAMETER :: PtfmRAzi = 503 ! Blade 1 Root Loads: - INTEGER(IntKi), PARAMETER :: RootFxc1 = 501 - INTEGER(IntKi), PARAMETER :: RootFyc1 = 502 - INTEGER(IntKi), PARAMETER :: RootFzc1 = 503 - INTEGER(IntKi), PARAMETER :: RootFxb1 = 504 - INTEGER(IntKi), PARAMETER :: RootFyb1 = 505 - INTEGER(IntKi), PARAMETER :: RootMxc1 = 506 - INTEGER(IntKi), PARAMETER :: RootMyc1 = 507 - INTEGER(IntKi), PARAMETER :: RootMzc1 = 508 - INTEGER(IntKi), PARAMETER :: RootMxb1 = 509 - INTEGER(IntKi), PARAMETER :: RootMyb1 = 510 + INTEGER(IntKi), PARAMETER :: RootFxc1 = 504 + INTEGER(IntKi), PARAMETER :: RootFyc1 = 505 + INTEGER(IntKi), PARAMETER :: RootFzc1 = 506 + INTEGER(IntKi), PARAMETER :: RootFxb1 = 507 + INTEGER(IntKi), PARAMETER :: RootFyb1 = 508 + INTEGER(IntKi), PARAMETER :: RootMxc1 = 509 + INTEGER(IntKi), PARAMETER :: RootMyc1 = 510 + INTEGER(IntKi), PARAMETER :: RootMzc1 = 511 + INTEGER(IntKi), PARAMETER :: RootMxb1 = 512 + INTEGER(IntKi), PARAMETER :: RootMyb1 = 513 ! Blade 2 Root Loads: - INTEGER(IntKi), PARAMETER :: RootFxc2 = 511 - INTEGER(IntKi), PARAMETER :: RootFyc2 = 512 - INTEGER(IntKi), PARAMETER :: RootFzc2 = 513 - INTEGER(IntKi), PARAMETER :: RootFxb2 = 514 - INTEGER(IntKi), PARAMETER :: RootFyb2 = 515 - INTEGER(IntKi), PARAMETER :: RootMxc2 = 516 - INTEGER(IntKi), PARAMETER :: RootMyc2 = 517 - INTEGER(IntKi), PARAMETER :: RootMzc2 = 518 - INTEGER(IntKi), PARAMETER :: RootMxb2 = 519 - INTEGER(IntKi), PARAMETER :: RootMyb2 = 520 + INTEGER(IntKi), PARAMETER :: RootFxc2 = 514 + INTEGER(IntKi), PARAMETER :: RootFyc2 = 515 + INTEGER(IntKi), PARAMETER :: RootFzc2 = 516 + INTEGER(IntKi), PARAMETER :: RootFxb2 = 517 + INTEGER(IntKi), PARAMETER :: RootFyb2 = 518 + INTEGER(IntKi), PARAMETER :: RootMxc2 = 519 + INTEGER(IntKi), PARAMETER :: RootMyc2 = 520 + INTEGER(IntKi), PARAMETER :: RootMzc2 = 521 + INTEGER(IntKi), PARAMETER :: RootMxb2 = 522 + INTEGER(IntKi), PARAMETER :: RootMyb2 = 523 ! Blade 3 Root Loads: - INTEGER(IntKi), PARAMETER :: RootFxc3 = 521 - INTEGER(IntKi), PARAMETER :: RootFyc3 = 522 - INTEGER(IntKi), PARAMETER :: RootFzc3 = 523 - INTEGER(IntKi), PARAMETER :: RootFxb3 = 524 - INTEGER(IntKi), PARAMETER :: RootFyb3 = 525 - INTEGER(IntKi), PARAMETER :: RootMxc3 = 526 - INTEGER(IntKi), PARAMETER :: RootMyc3 = 527 - INTEGER(IntKi), PARAMETER :: RootMzc3 = 528 - INTEGER(IntKi), PARAMETER :: RootMxb3 = 529 - INTEGER(IntKi), PARAMETER :: RootMyb3 = 530 + INTEGER(IntKi), PARAMETER :: RootFxc3 = 524 + INTEGER(IntKi), PARAMETER :: RootFyc3 = 525 + INTEGER(IntKi), PARAMETER :: RootFzc3 = 526 + INTEGER(IntKi), PARAMETER :: RootFxb3 = 527 + INTEGER(IntKi), PARAMETER :: RootFyb3 = 528 + INTEGER(IntKi), PARAMETER :: RootMxc3 = 529 + INTEGER(IntKi), PARAMETER :: RootMyc3 = 530 + INTEGER(IntKi), PARAMETER :: RootMzc3 = 531 + INTEGER(IntKi), PARAMETER :: RootMxb3 = 532 + INTEGER(IntKi), PARAMETER :: RootMyb3 = 533 ! Blade 1 Local Span Loads: - INTEGER(IntKi), PARAMETER :: Spn1MLxb1 = 531 - INTEGER(IntKi), PARAMETER :: Spn1MLyb1 = 532 - INTEGER(IntKi), PARAMETER :: Spn1MLzb1 = 533 - INTEGER(IntKi), PARAMETER :: Spn2MLxb1 = 534 - INTEGER(IntKi), PARAMETER :: Spn2MLyb1 = 535 - INTEGER(IntKi), PARAMETER :: Spn2MLzb1 = 536 - INTEGER(IntKi), PARAMETER :: Spn3MLxb1 = 537 - INTEGER(IntKi), PARAMETER :: Spn3MLyb1 = 538 - INTEGER(IntKi), PARAMETER :: Spn3MLzb1 = 539 - INTEGER(IntKi), PARAMETER :: Spn4MLxb1 = 540 - INTEGER(IntKi), PARAMETER :: Spn4MLyb1 = 541 - INTEGER(IntKi), PARAMETER :: Spn4MLzb1 = 542 - INTEGER(IntKi), PARAMETER :: Spn5MLxb1 = 543 - INTEGER(IntKi), PARAMETER :: Spn5MLyb1 = 544 - INTEGER(IntKi), PARAMETER :: Spn5MLzb1 = 545 - INTEGER(IntKi), PARAMETER :: Spn6MLxb1 = 546 - INTEGER(IntKi), PARAMETER :: Spn6MLyb1 = 547 - INTEGER(IntKi), PARAMETER :: Spn6MLzb1 = 548 - INTEGER(IntKi), PARAMETER :: Spn7MLxb1 = 549 - INTEGER(IntKi), PARAMETER :: Spn7MLyb1 = 550 - INTEGER(IntKi), PARAMETER :: Spn7MLzb1 = 551 - INTEGER(IntKi), PARAMETER :: Spn8MLxb1 = 552 - INTEGER(IntKi), PARAMETER :: Spn8MLyb1 = 553 - INTEGER(IntKi), PARAMETER :: Spn8MLzb1 = 554 - INTEGER(IntKi), PARAMETER :: Spn9MLxb1 = 555 - INTEGER(IntKi), PARAMETER :: Spn9MLyb1 = 556 - INTEGER(IntKi), PARAMETER :: Spn9MLzb1 = 557 - INTEGER(IntKi), PARAMETER :: Spn1FLxb1 = 558 - INTEGER(IntKi), PARAMETER :: Spn1FLyb1 = 559 - INTEGER(IntKi), PARAMETER :: Spn1FLzb1 = 560 - INTEGER(IntKi), PARAMETER :: Spn2FLxb1 = 561 - INTEGER(IntKi), PARAMETER :: Spn2FLyb1 = 562 - INTEGER(IntKi), PARAMETER :: Spn2FLzb1 = 563 - INTEGER(IntKi), PARAMETER :: Spn3FLxb1 = 564 - INTEGER(IntKi), PARAMETER :: Spn3FLyb1 = 565 - INTEGER(IntKi), PARAMETER :: Spn3FLzb1 = 566 - INTEGER(IntKi), PARAMETER :: Spn4FLxb1 = 567 - INTEGER(IntKi), PARAMETER :: Spn4FLyb1 = 568 - INTEGER(IntKi), PARAMETER :: Spn4FLzb1 = 569 - INTEGER(IntKi), PARAMETER :: Spn5FLxb1 = 570 - INTEGER(IntKi), PARAMETER :: Spn5FLyb1 = 571 - INTEGER(IntKi), PARAMETER :: Spn5FLzb1 = 572 - INTEGER(IntKi), PARAMETER :: Spn6FLxb1 = 573 - INTEGER(IntKi), PARAMETER :: Spn6FLyb1 = 574 - INTEGER(IntKi), PARAMETER :: Spn6FLzb1 = 575 - INTEGER(IntKi), PARAMETER :: Spn7FLxb1 = 576 - INTEGER(IntKi), PARAMETER :: Spn7FLyb1 = 577 - INTEGER(IntKi), PARAMETER :: Spn7FLzb1 = 578 - INTEGER(IntKi), PARAMETER :: Spn8FLxb1 = 579 - INTEGER(IntKi), PARAMETER :: Spn8FLyb1 = 580 - INTEGER(IntKi), PARAMETER :: Spn8FLzb1 = 581 - INTEGER(IntKi), PARAMETER :: Spn9FLxb1 = 582 - INTEGER(IntKi), PARAMETER :: Spn9FLyb1 = 583 - INTEGER(IntKi), PARAMETER :: Spn9FLzb1 = 584 + INTEGER(IntKi), PARAMETER :: Spn1MLxb1 = 534 + INTEGER(IntKi), PARAMETER :: Spn1MLyb1 = 535 + INTEGER(IntKi), PARAMETER :: Spn1MLzb1 = 536 + INTEGER(IntKi), PARAMETER :: Spn2MLxb1 = 537 + INTEGER(IntKi), PARAMETER :: Spn2MLyb1 = 538 + INTEGER(IntKi), PARAMETER :: Spn2MLzb1 = 539 + INTEGER(IntKi), PARAMETER :: Spn3MLxb1 = 540 + INTEGER(IntKi), PARAMETER :: Spn3MLyb1 = 541 + INTEGER(IntKi), PARAMETER :: Spn3MLzb1 = 542 + INTEGER(IntKi), PARAMETER :: Spn4MLxb1 = 543 + INTEGER(IntKi), PARAMETER :: Spn4MLyb1 = 544 + INTEGER(IntKi), PARAMETER :: Spn4MLzb1 = 545 + INTEGER(IntKi), PARAMETER :: Spn5MLxb1 = 546 + INTEGER(IntKi), PARAMETER :: Spn5MLyb1 = 547 + INTEGER(IntKi), PARAMETER :: Spn5MLzb1 = 548 + INTEGER(IntKi), PARAMETER :: Spn6MLxb1 = 549 + INTEGER(IntKi), PARAMETER :: Spn6MLyb1 = 550 + INTEGER(IntKi), PARAMETER :: Spn6MLzb1 = 551 + INTEGER(IntKi), PARAMETER :: Spn7MLxb1 = 552 + INTEGER(IntKi), PARAMETER :: Spn7MLyb1 = 553 + INTEGER(IntKi), PARAMETER :: Spn7MLzb1 = 554 + INTEGER(IntKi), PARAMETER :: Spn8MLxb1 = 555 + INTEGER(IntKi), PARAMETER :: Spn8MLyb1 = 556 + INTEGER(IntKi), PARAMETER :: Spn8MLzb1 = 557 + INTEGER(IntKi), PARAMETER :: Spn9MLxb1 = 558 + INTEGER(IntKi), PARAMETER :: Spn9MLyb1 = 559 + INTEGER(IntKi), PARAMETER :: Spn9MLzb1 = 560 + INTEGER(IntKi), PARAMETER :: Spn1FLxb1 = 561 + INTEGER(IntKi), PARAMETER :: Spn1FLyb1 = 562 + INTEGER(IntKi), PARAMETER :: Spn1FLzb1 = 563 + INTEGER(IntKi), PARAMETER :: Spn2FLxb1 = 564 + INTEGER(IntKi), PARAMETER :: Spn2FLyb1 = 565 + INTEGER(IntKi), PARAMETER :: Spn2FLzb1 = 566 + INTEGER(IntKi), PARAMETER :: Spn3FLxb1 = 567 + INTEGER(IntKi), PARAMETER :: Spn3FLyb1 = 568 + INTEGER(IntKi), PARAMETER :: Spn3FLzb1 = 569 + INTEGER(IntKi), PARAMETER :: Spn4FLxb1 = 570 + INTEGER(IntKi), PARAMETER :: Spn4FLyb1 = 571 + INTEGER(IntKi), PARAMETER :: Spn4FLzb1 = 572 + INTEGER(IntKi), PARAMETER :: Spn5FLxb1 = 573 + INTEGER(IntKi), PARAMETER :: Spn5FLyb1 = 574 + INTEGER(IntKi), PARAMETER :: Spn5FLzb1 = 575 + INTEGER(IntKi), PARAMETER :: Spn6FLxb1 = 576 + INTEGER(IntKi), PARAMETER :: Spn6FLyb1 = 577 + INTEGER(IntKi), PARAMETER :: Spn6FLzb1 = 578 + INTEGER(IntKi), PARAMETER :: Spn7FLxb1 = 579 + INTEGER(IntKi), PARAMETER :: Spn7FLyb1 = 580 + INTEGER(IntKi), PARAMETER :: Spn7FLzb1 = 581 + INTEGER(IntKi), PARAMETER :: Spn8FLxb1 = 582 + INTEGER(IntKi), PARAMETER :: Spn8FLyb1 = 583 + INTEGER(IntKi), PARAMETER :: Spn8FLzb1 = 584 + INTEGER(IntKi), PARAMETER :: Spn9FLxb1 = 585 + INTEGER(IntKi), PARAMETER :: Spn9FLyb1 = 586 + INTEGER(IntKi), PARAMETER :: Spn9FLzb1 = 587 ! Blade 2 Local Span Loads: - INTEGER(IntKi), PARAMETER :: Spn1MLxb2 = 585 - INTEGER(IntKi), PARAMETER :: Spn1MLyb2 = 586 - INTEGER(IntKi), PARAMETER :: Spn1MLzb2 = 587 - INTEGER(IntKi), PARAMETER :: Spn2MLxb2 = 588 - INTEGER(IntKi), PARAMETER :: Spn2MLyb2 = 589 - INTEGER(IntKi), PARAMETER :: Spn2MLzb2 = 590 - INTEGER(IntKi), PARAMETER :: Spn3MLxb2 = 591 - INTEGER(IntKi), PARAMETER :: Spn3MLyb2 = 592 - INTEGER(IntKi), PARAMETER :: Spn3MLzb2 = 593 - INTEGER(IntKi), PARAMETER :: Spn4MLxb2 = 594 - INTEGER(IntKi), PARAMETER :: Spn4MLyb2 = 595 - INTEGER(IntKi), PARAMETER :: Spn4MLzb2 = 596 - INTEGER(IntKi), PARAMETER :: Spn5MLxb2 = 597 - INTEGER(IntKi), PARAMETER :: Spn5MLyb2 = 598 - INTEGER(IntKi), PARAMETER :: Spn5MLzb2 = 599 - INTEGER(IntKi), PARAMETER :: Spn6MLxb2 = 600 - INTEGER(IntKi), PARAMETER :: Spn6MLyb2 = 601 - INTEGER(IntKi), PARAMETER :: Spn6MLzb2 = 602 - INTEGER(IntKi), PARAMETER :: Spn7MLxb2 = 603 - INTEGER(IntKi), PARAMETER :: Spn7MLyb2 = 604 - INTEGER(IntKi), PARAMETER :: Spn7MLzb2 = 605 - INTEGER(IntKi), PARAMETER :: Spn8MLxb2 = 606 - INTEGER(IntKi), PARAMETER :: Spn8MLyb2 = 607 - INTEGER(IntKi), PARAMETER :: Spn8MLzb2 = 608 - INTEGER(IntKi), PARAMETER :: Spn9MLxb2 = 609 - INTEGER(IntKi), PARAMETER :: Spn9MLyb2 = 610 - INTEGER(IntKi), PARAMETER :: Spn9MLzb2 = 611 - INTEGER(IntKi), PARAMETER :: Spn1FLxb2 = 612 - INTEGER(IntKi), PARAMETER :: Spn1FLyb2 = 613 - INTEGER(IntKi), PARAMETER :: Spn1FLzb2 = 614 - INTEGER(IntKi), PARAMETER :: Spn2FLxb2 = 615 - INTEGER(IntKi), PARAMETER :: Spn2FLyb2 = 616 - INTEGER(IntKi), PARAMETER :: Spn2FLzb2 = 617 - INTEGER(IntKi), PARAMETER :: Spn3FLxb2 = 618 - INTEGER(IntKi), PARAMETER :: Spn3FLyb2 = 619 - INTEGER(IntKi), PARAMETER :: Spn3FLzb2 = 620 - INTEGER(IntKi), PARAMETER :: Spn4FLxb2 = 621 - INTEGER(IntKi), PARAMETER :: Spn4FLyb2 = 622 - INTEGER(IntKi), PARAMETER :: Spn4FLzb2 = 623 - INTEGER(IntKi), PARAMETER :: Spn5FLxb2 = 624 - INTEGER(IntKi), PARAMETER :: Spn5FLyb2 = 625 - INTEGER(IntKi), PARAMETER :: Spn5FLzb2 = 626 - INTEGER(IntKi), PARAMETER :: Spn6FLxb2 = 627 - INTEGER(IntKi), PARAMETER :: Spn6FLyb2 = 628 - INTEGER(IntKi), PARAMETER :: Spn6FLzb2 = 629 - INTEGER(IntKi), PARAMETER :: Spn7FLxb2 = 630 - INTEGER(IntKi), PARAMETER :: Spn7FLyb2 = 631 - INTEGER(IntKi), PARAMETER :: Spn7FLzb2 = 632 - INTEGER(IntKi), PARAMETER :: Spn8FLxb2 = 633 - INTEGER(IntKi), PARAMETER :: Spn8FLyb2 = 634 - INTEGER(IntKi), PARAMETER :: Spn8FLzb2 = 635 - INTEGER(IntKi), PARAMETER :: Spn9FLxb2 = 636 - INTEGER(IntKi), PARAMETER :: Spn9FLyb2 = 637 - INTEGER(IntKi), PARAMETER :: Spn9FLzb2 = 638 + INTEGER(IntKi), PARAMETER :: Spn1MLxb2 = 588 + INTEGER(IntKi), PARAMETER :: Spn1MLyb2 = 589 + INTEGER(IntKi), PARAMETER :: Spn1MLzb2 = 590 + INTEGER(IntKi), PARAMETER :: Spn2MLxb2 = 591 + INTEGER(IntKi), PARAMETER :: Spn2MLyb2 = 592 + INTEGER(IntKi), PARAMETER :: Spn2MLzb2 = 593 + INTEGER(IntKi), PARAMETER :: Spn3MLxb2 = 594 + INTEGER(IntKi), PARAMETER :: Spn3MLyb2 = 595 + INTEGER(IntKi), PARAMETER :: Spn3MLzb2 = 596 + INTEGER(IntKi), PARAMETER :: Spn4MLxb2 = 597 + INTEGER(IntKi), PARAMETER :: Spn4MLyb2 = 598 + INTEGER(IntKi), PARAMETER :: Spn4MLzb2 = 599 + INTEGER(IntKi), PARAMETER :: Spn5MLxb2 = 600 + INTEGER(IntKi), PARAMETER :: Spn5MLyb2 = 601 + INTEGER(IntKi), PARAMETER :: Spn5MLzb2 = 602 + INTEGER(IntKi), PARAMETER :: Spn6MLxb2 = 603 + INTEGER(IntKi), PARAMETER :: Spn6MLyb2 = 604 + INTEGER(IntKi), PARAMETER :: Spn6MLzb2 = 605 + INTEGER(IntKi), PARAMETER :: Spn7MLxb2 = 606 + INTEGER(IntKi), PARAMETER :: Spn7MLyb2 = 607 + INTEGER(IntKi), PARAMETER :: Spn7MLzb2 = 608 + INTEGER(IntKi), PARAMETER :: Spn8MLxb2 = 609 + INTEGER(IntKi), PARAMETER :: Spn8MLyb2 = 610 + INTEGER(IntKi), PARAMETER :: Spn8MLzb2 = 611 + INTEGER(IntKi), PARAMETER :: Spn9MLxb2 = 612 + INTEGER(IntKi), PARAMETER :: Spn9MLyb2 = 613 + INTEGER(IntKi), PARAMETER :: Spn9MLzb2 = 614 + INTEGER(IntKi), PARAMETER :: Spn1FLxb2 = 615 + INTEGER(IntKi), PARAMETER :: Spn1FLyb2 = 616 + INTEGER(IntKi), PARAMETER :: Spn1FLzb2 = 617 + INTEGER(IntKi), PARAMETER :: Spn2FLxb2 = 618 + INTEGER(IntKi), PARAMETER :: Spn2FLyb2 = 619 + INTEGER(IntKi), PARAMETER :: Spn2FLzb2 = 620 + INTEGER(IntKi), PARAMETER :: Spn3FLxb2 = 621 + INTEGER(IntKi), PARAMETER :: Spn3FLyb2 = 622 + INTEGER(IntKi), PARAMETER :: Spn3FLzb2 = 623 + INTEGER(IntKi), PARAMETER :: Spn4FLxb2 = 624 + INTEGER(IntKi), PARAMETER :: Spn4FLyb2 = 625 + INTEGER(IntKi), PARAMETER :: Spn4FLzb2 = 626 + INTEGER(IntKi), PARAMETER :: Spn5FLxb2 = 627 + INTEGER(IntKi), PARAMETER :: Spn5FLyb2 = 628 + INTEGER(IntKi), PARAMETER :: Spn5FLzb2 = 629 + INTEGER(IntKi), PARAMETER :: Spn6FLxb2 = 630 + INTEGER(IntKi), PARAMETER :: Spn6FLyb2 = 631 + INTEGER(IntKi), PARAMETER :: Spn6FLzb2 = 632 + INTEGER(IntKi), PARAMETER :: Spn7FLxb2 = 633 + INTEGER(IntKi), PARAMETER :: Spn7FLyb2 = 634 + INTEGER(IntKi), PARAMETER :: Spn7FLzb2 = 635 + INTEGER(IntKi), PARAMETER :: Spn8FLxb2 = 636 + INTEGER(IntKi), PARAMETER :: Spn8FLyb2 = 637 + INTEGER(IntKi), PARAMETER :: Spn8FLzb2 = 638 + INTEGER(IntKi), PARAMETER :: Spn9FLxb2 = 639 + INTEGER(IntKi), PARAMETER :: Spn9FLyb2 = 640 + INTEGER(IntKi), PARAMETER :: Spn9FLzb2 = 641 ! Blade 3 Local Span Loads: - INTEGER(IntKi), PARAMETER :: Spn1MLxb3 = 639 - INTEGER(IntKi), PARAMETER :: Spn1MLyb3 = 640 - INTEGER(IntKi), PARAMETER :: Spn1MLzb3 = 641 - INTEGER(IntKi), PARAMETER :: Spn2MLxb3 = 642 - INTEGER(IntKi), PARAMETER :: Spn2MLyb3 = 643 - INTEGER(IntKi), PARAMETER :: Spn2MLzb3 = 644 - INTEGER(IntKi), PARAMETER :: Spn3MLxb3 = 645 - INTEGER(IntKi), PARAMETER :: Spn3MLyb3 = 646 - INTEGER(IntKi), PARAMETER :: Spn3MLzb3 = 647 - INTEGER(IntKi), PARAMETER :: Spn4MLxb3 = 648 - INTEGER(IntKi), PARAMETER :: Spn4MLyb3 = 649 - INTEGER(IntKi), PARAMETER :: Spn4MLzb3 = 650 - INTEGER(IntKi), PARAMETER :: Spn5MLxb3 = 651 - INTEGER(IntKi), PARAMETER :: Spn5MLyb3 = 652 - INTEGER(IntKi), PARAMETER :: Spn5MLzb3 = 653 - INTEGER(IntKi), PARAMETER :: Spn6MLxb3 = 654 - INTEGER(IntKi), PARAMETER :: Spn6MLyb3 = 655 - INTEGER(IntKi), PARAMETER :: Spn6MLzb3 = 656 - INTEGER(IntKi), PARAMETER :: Spn7MLxb3 = 657 - INTEGER(IntKi), PARAMETER :: Spn7MLyb3 = 658 - INTEGER(IntKi), PARAMETER :: Spn7MLzb3 = 659 - INTEGER(IntKi), PARAMETER :: Spn8MLxb3 = 660 - INTEGER(IntKi), PARAMETER :: Spn8MLyb3 = 661 - INTEGER(IntKi), PARAMETER :: Spn8MLzb3 = 662 - INTEGER(IntKi), PARAMETER :: Spn9MLxb3 = 663 - INTEGER(IntKi), PARAMETER :: Spn9MLyb3 = 664 - INTEGER(IntKi), PARAMETER :: Spn9MLzb3 = 665 - INTEGER(IntKi), PARAMETER :: Spn1FLxb3 = 666 - INTEGER(IntKi), PARAMETER :: Spn1FLyb3 = 667 - INTEGER(IntKi), PARAMETER :: Spn1FLzb3 = 668 - INTEGER(IntKi), PARAMETER :: Spn2FLxb3 = 669 - INTEGER(IntKi), PARAMETER :: Spn2FLyb3 = 670 - INTEGER(IntKi), PARAMETER :: Spn2FLzb3 = 671 - INTEGER(IntKi), PARAMETER :: Spn3FLxb3 = 672 - INTEGER(IntKi), PARAMETER :: Spn3FLyb3 = 673 - INTEGER(IntKi), PARAMETER :: Spn3FLzb3 = 674 - INTEGER(IntKi), PARAMETER :: Spn4FLxb3 = 675 - INTEGER(IntKi), PARAMETER :: Spn4FLyb3 = 676 - INTEGER(IntKi), PARAMETER :: Spn4FLzb3 = 677 - INTEGER(IntKi), PARAMETER :: Spn5FLxb3 = 678 - INTEGER(IntKi), PARAMETER :: Spn5FLyb3 = 679 - INTEGER(IntKi), PARAMETER :: Spn5FLzb3 = 680 - INTEGER(IntKi), PARAMETER :: Spn6FLxb3 = 681 - INTEGER(IntKi), PARAMETER :: Spn6FLyb3 = 682 - INTEGER(IntKi), PARAMETER :: Spn6FLzb3 = 683 - INTEGER(IntKi), PARAMETER :: Spn7FLxb3 = 684 - INTEGER(IntKi), PARAMETER :: Spn7FLyb3 = 685 - INTEGER(IntKi), PARAMETER :: Spn7FLzb3 = 686 - INTEGER(IntKi), PARAMETER :: Spn8FLxb3 = 687 - INTEGER(IntKi), PARAMETER :: Spn8FLyb3 = 688 - INTEGER(IntKi), PARAMETER :: Spn8FLzb3 = 689 - INTEGER(IntKi), PARAMETER :: Spn9FLxb3 = 690 - INTEGER(IntKi), PARAMETER :: Spn9FLyb3 = 691 - INTEGER(IntKi), PARAMETER :: Spn9FLzb3 = 692 + INTEGER(IntKi), PARAMETER :: Spn1MLxb3 = 642 + INTEGER(IntKi), PARAMETER :: Spn1MLyb3 = 643 + INTEGER(IntKi), PARAMETER :: Spn1MLzb3 = 644 + INTEGER(IntKi), PARAMETER :: Spn2MLxb3 = 645 + INTEGER(IntKi), PARAMETER :: Spn2MLyb3 = 646 + INTEGER(IntKi), PARAMETER :: Spn2MLzb3 = 647 + INTEGER(IntKi), PARAMETER :: Spn3MLxb3 = 648 + INTEGER(IntKi), PARAMETER :: Spn3MLyb3 = 649 + INTEGER(IntKi), PARAMETER :: Spn3MLzb3 = 650 + INTEGER(IntKi), PARAMETER :: Spn4MLxb3 = 651 + INTEGER(IntKi), PARAMETER :: Spn4MLyb3 = 652 + INTEGER(IntKi), PARAMETER :: Spn4MLzb3 = 653 + INTEGER(IntKi), PARAMETER :: Spn5MLxb3 = 654 + INTEGER(IntKi), PARAMETER :: Spn5MLyb3 = 655 + INTEGER(IntKi), PARAMETER :: Spn5MLzb3 = 656 + INTEGER(IntKi), PARAMETER :: Spn6MLxb3 = 657 + INTEGER(IntKi), PARAMETER :: Spn6MLyb3 = 658 + INTEGER(IntKi), PARAMETER :: Spn6MLzb3 = 659 + INTEGER(IntKi), PARAMETER :: Spn7MLxb3 = 660 + INTEGER(IntKi), PARAMETER :: Spn7MLyb3 = 661 + INTEGER(IntKi), PARAMETER :: Spn7MLzb3 = 662 + INTEGER(IntKi), PARAMETER :: Spn8MLxb3 = 663 + INTEGER(IntKi), PARAMETER :: Spn8MLyb3 = 664 + INTEGER(IntKi), PARAMETER :: Spn8MLzb3 = 665 + INTEGER(IntKi), PARAMETER :: Spn9MLxb3 = 666 + INTEGER(IntKi), PARAMETER :: Spn9MLyb3 = 667 + INTEGER(IntKi), PARAMETER :: Spn9MLzb3 = 668 + INTEGER(IntKi), PARAMETER :: Spn1FLxb3 = 669 + INTEGER(IntKi), PARAMETER :: Spn1FLyb3 = 670 + INTEGER(IntKi), PARAMETER :: Spn1FLzb3 = 671 + INTEGER(IntKi), PARAMETER :: Spn2FLxb3 = 672 + INTEGER(IntKi), PARAMETER :: Spn2FLyb3 = 673 + INTEGER(IntKi), PARAMETER :: Spn2FLzb3 = 674 + INTEGER(IntKi), PARAMETER :: Spn3FLxb3 = 675 + INTEGER(IntKi), PARAMETER :: Spn3FLyb3 = 676 + INTEGER(IntKi), PARAMETER :: Spn3FLzb3 = 677 + INTEGER(IntKi), PARAMETER :: Spn4FLxb3 = 678 + INTEGER(IntKi), PARAMETER :: Spn4FLyb3 = 679 + INTEGER(IntKi), PARAMETER :: Spn4FLzb3 = 680 + INTEGER(IntKi), PARAMETER :: Spn5FLxb3 = 681 + INTEGER(IntKi), PARAMETER :: Spn5FLyb3 = 682 + INTEGER(IntKi), PARAMETER :: Spn5FLzb3 = 683 + INTEGER(IntKi), PARAMETER :: Spn6FLxb3 = 684 + INTEGER(IntKi), PARAMETER :: Spn6FLyb3 = 685 + INTEGER(IntKi), PARAMETER :: Spn6FLzb3 = 686 + INTEGER(IntKi), PARAMETER :: Spn7FLxb3 = 687 + INTEGER(IntKi), PARAMETER :: Spn7FLyb3 = 688 + INTEGER(IntKi), PARAMETER :: Spn7FLzb3 = 689 + INTEGER(IntKi), PARAMETER :: Spn8FLxb3 = 690 + INTEGER(IntKi), PARAMETER :: Spn8FLyb3 = 691 + INTEGER(IntKi), PARAMETER :: Spn8FLzb3 = 692 + INTEGER(IntKi), PARAMETER :: Spn9FLxb3 = 693 + INTEGER(IntKi), PARAMETER :: Spn9FLyb3 = 694 + INTEGER(IntKi), PARAMETER :: Spn9FLzb3 = 695 ! Hub and Rotor Loads: - INTEGER(IntKi), PARAMETER :: LSShftFxa = 693 - INTEGER(IntKi), PARAMETER :: LSShftFya = 694 - INTEGER(IntKi), PARAMETER :: LSShftFza = 695 - INTEGER(IntKi), PARAMETER :: LSShftFys = 696 - INTEGER(IntKi), PARAMETER :: LSShftFzs = 697 - INTEGER(IntKi), PARAMETER :: LSShftMxa = 698 - INTEGER(IntKi), PARAMETER :: LSSTipMya = 699 - INTEGER(IntKi), PARAMETER :: LSSTipMza = 700 - INTEGER(IntKi), PARAMETER :: LSSTipMys = 701 - INTEGER(IntKi), PARAMETER :: LSSTipMzs = 702 - INTEGER(IntKi), PARAMETER :: RotPwr = 703 + INTEGER(IntKi), PARAMETER :: LSShftFxa = 696 + INTEGER(IntKi), PARAMETER :: LSShftFya = 697 + INTEGER(IntKi), PARAMETER :: LSShftFza = 698 + INTEGER(IntKi), PARAMETER :: LSShftFys = 699 + INTEGER(IntKi), PARAMETER :: LSShftFzs = 700 + INTEGER(IntKi), PARAMETER :: LSShftMxa = 701 + INTEGER(IntKi), PARAMETER :: LSSTipMya = 702 + INTEGER(IntKi), PARAMETER :: LSSTipMza = 703 + INTEGER(IntKi), PARAMETER :: LSSTipMys = 704 + INTEGER(IntKi), PARAMETER :: LSSTipMzs = 705 + INTEGER(IntKi), PARAMETER :: RotPwr = 706 ! Shaft Strain Gage Loads: - INTEGER(IntKi), PARAMETER :: LSSGagMya = 704 - INTEGER(IntKi), PARAMETER :: LSSGagMza = 705 - INTEGER(IntKi), PARAMETER :: LSSGagMys = 706 - INTEGER(IntKi), PARAMETER :: LSSGagMzs = 707 + INTEGER(IntKi), PARAMETER :: LSSGagMya = 707 + INTEGER(IntKi), PARAMETER :: LSSGagMza = 708 + INTEGER(IntKi), PARAMETER :: LSSGagMys = 709 + INTEGER(IntKi), PARAMETER :: LSSGagMzs = 710 ! High-Speed Shaft Loads: - INTEGER(IntKi), PARAMETER :: HSShftTq = 708 - INTEGER(IntKi), PARAMETER :: HSSBrTq = 709 - INTEGER(IntKi), PARAMETER :: HSShftPwr = 710 + INTEGER(IntKi), PARAMETER :: HSShftTq = 711 + INTEGER(IntKi), PARAMETER :: HSSBrTq = 712 + INTEGER(IntKi), PARAMETER :: HSShftPwr = 713 ! Rotor-Furl Bearing Loads: - INTEGER(IntKi), PARAMETER :: RFrlBrM = 711 + INTEGER(IntKi), PARAMETER :: RFrlBrM = 714 ! Tail-Furl Bearing Loads: - INTEGER(IntKi), PARAMETER :: TFrlBrM = 712 + INTEGER(IntKi), PARAMETER :: TFrlBrM = 715 ! Tower-Top / Yaw Bearing Loads: - INTEGER(IntKi), PARAMETER :: YawBrFxn = 713 - INTEGER(IntKi), PARAMETER :: YawBrFyn = 714 - INTEGER(IntKi), PARAMETER :: YawBrFzn = 715 - INTEGER(IntKi), PARAMETER :: YawBrFxp = 716 - INTEGER(IntKi), PARAMETER :: YawBrFyp = 717 - INTEGER(IntKi), PARAMETER :: YawBrMxn = 718 - INTEGER(IntKi), PARAMETER :: YawBrMyn = 719 - INTEGER(IntKi), PARAMETER :: YawBrMzn = 720 - INTEGER(IntKi), PARAMETER :: YawBrMxp = 721 - INTEGER(IntKi), PARAMETER :: YawBrMyp = 722 + INTEGER(IntKi), PARAMETER :: YawBrFxn = 716 + INTEGER(IntKi), PARAMETER :: YawBrFyn = 717 + INTEGER(IntKi), PARAMETER :: YawBrFzn = 718 + INTEGER(IntKi), PARAMETER :: YawBrFxp = 719 + INTEGER(IntKi), PARAMETER :: YawBrFyp = 720 + INTEGER(IntKi), PARAMETER :: YawBrMxn = 721 + INTEGER(IntKi), PARAMETER :: YawBrMyn = 722 + INTEGER(IntKi), PARAMETER :: YawBrMzn = 723 + INTEGER(IntKi), PARAMETER :: YawBrMxp = 724 + INTEGER(IntKi), PARAMETER :: YawBrMyp = 725 ! Tower Base Loads: - INTEGER(IntKi), PARAMETER :: TwrBsFxt = 723 - INTEGER(IntKi), PARAMETER :: TwrBsFyt = 724 - INTEGER(IntKi), PARAMETER :: TwrBsFzt = 725 - INTEGER(IntKi), PARAMETER :: TwrBsMxt = 726 - INTEGER(IntKi), PARAMETER :: TwrBsMyt = 727 - INTEGER(IntKi), PARAMETER :: TwrBsMzt = 728 + INTEGER(IntKi), PARAMETER :: TwrBsFxt = 726 + INTEGER(IntKi), PARAMETER :: TwrBsFyt = 727 + INTEGER(IntKi), PARAMETER :: TwrBsFzt = 728 + INTEGER(IntKi), PARAMETER :: TwrBsMxt = 729 + INTEGER(IntKi), PARAMETER :: TwrBsMyt = 730 + INTEGER(IntKi), PARAMETER :: TwrBsMzt = 731 ! Local Tower Loads: - INTEGER(IntKi), PARAMETER :: TwHt1MLxt = 729 - INTEGER(IntKi), PARAMETER :: TwHt1MLyt = 730 - INTEGER(IntKi), PARAMETER :: TwHt1MLzt = 731 - INTEGER(IntKi), PARAMETER :: TwHt2MLxt = 732 - INTEGER(IntKi), PARAMETER :: TwHt2MLyt = 733 - INTEGER(IntKi), PARAMETER :: TwHt2MLzt = 734 - INTEGER(IntKi), PARAMETER :: TwHt3MLxt = 735 - INTEGER(IntKi), PARAMETER :: TwHt3MLyt = 736 - INTEGER(IntKi), PARAMETER :: TwHt3MLzt = 737 - INTEGER(IntKi), PARAMETER :: TwHt4MLxt = 738 - INTEGER(IntKi), PARAMETER :: TwHt4MLyt = 739 - INTEGER(IntKi), PARAMETER :: TwHt4MLzt = 740 - INTEGER(IntKi), PARAMETER :: TwHt5MLxt = 741 - INTEGER(IntKi), PARAMETER :: TwHt5MLyt = 742 - INTEGER(IntKi), PARAMETER :: TwHt5MLzt = 743 - INTEGER(IntKi), PARAMETER :: TwHt6MLxt = 744 - INTEGER(IntKi), PARAMETER :: TwHt6MLyt = 745 - INTEGER(IntKi), PARAMETER :: TwHt6MLzt = 746 - INTEGER(IntKi), PARAMETER :: TwHt7MLxt = 747 - INTEGER(IntKi), PARAMETER :: TwHt7MLyt = 748 - INTEGER(IntKi), PARAMETER :: TwHt7MLzt = 749 - INTEGER(IntKi), PARAMETER :: TwHt8MLxt = 750 - INTEGER(IntKi), PARAMETER :: TwHt8MLyt = 751 - INTEGER(IntKi), PARAMETER :: TwHt8MLzt = 752 - INTEGER(IntKi), PARAMETER :: TwHt9MLxt = 753 - INTEGER(IntKi), PARAMETER :: TwHt9MLyt = 754 - INTEGER(IntKi), PARAMETER :: TwHt9MLzt = 755 - INTEGER(IntKi), PARAMETER :: TwHt1FLxt = 756 - INTEGER(IntKi), PARAMETER :: TwHt1FLyt = 757 - INTEGER(IntKi), PARAMETER :: TwHt1FLzt = 758 - INTEGER(IntKi), PARAMETER :: TwHt2FLxt = 759 - INTEGER(IntKi), PARAMETER :: TwHt2FLyt = 760 - INTEGER(IntKi), PARAMETER :: TwHt2FLzt = 761 - INTEGER(IntKi), PARAMETER :: TwHt3FLxt = 762 - INTEGER(IntKi), PARAMETER :: TwHt3FLyt = 763 - INTEGER(IntKi), PARAMETER :: TwHt3FLzt = 764 - INTEGER(IntKi), PARAMETER :: TwHt4FLxt = 765 - INTEGER(IntKi), PARAMETER :: TwHt4FLyt = 766 - INTEGER(IntKi), PARAMETER :: TwHt4FLzt = 767 - INTEGER(IntKi), PARAMETER :: TwHt5FLxt = 768 - INTEGER(IntKi), PARAMETER :: TwHt5FLyt = 769 - INTEGER(IntKi), PARAMETER :: TwHt5FLzt = 770 - INTEGER(IntKi), PARAMETER :: TwHt6FLxt = 771 - INTEGER(IntKi), PARAMETER :: TwHt6FLyt = 772 - INTEGER(IntKi), PARAMETER :: TwHt6FLzt = 773 - INTEGER(IntKi), PARAMETER :: TwHt7FLxt = 774 - INTEGER(IntKi), PARAMETER :: TwHt7FLyt = 775 - INTEGER(IntKi), PARAMETER :: TwHt7FLzt = 776 - INTEGER(IntKi), PARAMETER :: TwHt8FLxt = 777 - INTEGER(IntKi), PARAMETER :: TwHt8FLyt = 778 - INTEGER(IntKi), PARAMETER :: TwHt8FLzt = 779 - INTEGER(IntKi), PARAMETER :: TwHt9FLxt = 780 - INTEGER(IntKi), PARAMETER :: TwHt9FLyt = 781 - INTEGER(IntKi), PARAMETER :: TwHt9FLzt = 782 + INTEGER(IntKi), PARAMETER :: TwHt1MLxt = 732 + INTEGER(IntKi), PARAMETER :: TwHt1MLyt = 733 + INTEGER(IntKi), PARAMETER :: TwHt1MLzt = 734 + INTEGER(IntKi), PARAMETER :: TwHt2MLxt = 735 + INTEGER(IntKi), PARAMETER :: TwHt2MLyt = 736 + INTEGER(IntKi), PARAMETER :: TwHt2MLzt = 737 + INTEGER(IntKi), PARAMETER :: TwHt3MLxt = 738 + INTEGER(IntKi), PARAMETER :: TwHt3MLyt = 739 + INTEGER(IntKi), PARAMETER :: TwHt3MLzt = 740 + INTEGER(IntKi), PARAMETER :: TwHt4MLxt = 741 + INTEGER(IntKi), PARAMETER :: TwHt4MLyt = 742 + INTEGER(IntKi), PARAMETER :: TwHt4MLzt = 743 + INTEGER(IntKi), PARAMETER :: TwHt5MLxt = 744 + INTEGER(IntKi), PARAMETER :: TwHt5MLyt = 745 + INTEGER(IntKi), PARAMETER :: TwHt5MLzt = 746 + INTEGER(IntKi), PARAMETER :: TwHt6MLxt = 747 + INTEGER(IntKi), PARAMETER :: TwHt6MLyt = 748 + INTEGER(IntKi), PARAMETER :: TwHt6MLzt = 749 + INTEGER(IntKi), PARAMETER :: TwHt7MLxt = 750 + INTEGER(IntKi), PARAMETER :: TwHt7MLyt = 751 + INTEGER(IntKi), PARAMETER :: TwHt7MLzt = 752 + INTEGER(IntKi), PARAMETER :: TwHt8MLxt = 753 + INTEGER(IntKi), PARAMETER :: TwHt8MLyt = 754 + INTEGER(IntKi), PARAMETER :: TwHt8MLzt = 755 + INTEGER(IntKi), PARAMETER :: TwHt9MLxt = 756 + INTEGER(IntKi), PARAMETER :: TwHt9MLyt = 757 + INTEGER(IntKi), PARAMETER :: TwHt9MLzt = 758 + INTEGER(IntKi), PARAMETER :: TwHt1FLxt = 759 + INTEGER(IntKi), PARAMETER :: TwHt1FLyt = 760 + INTEGER(IntKi), PARAMETER :: TwHt1FLzt = 761 + INTEGER(IntKi), PARAMETER :: TwHt2FLxt = 762 + INTEGER(IntKi), PARAMETER :: TwHt2FLyt = 763 + INTEGER(IntKi), PARAMETER :: TwHt2FLzt = 764 + INTEGER(IntKi), PARAMETER :: TwHt3FLxt = 765 + INTEGER(IntKi), PARAMETER :: TwHt3FLyt = 766 + INTEGER(IntKi), PARAMETER :: TwHt3FLzt = 767 + INTEGER(IntKi), PARAMETER :: TwHt4FLxt = 768 + INTEGER(IntKi), PARAMETER :: TwHt4FLyt = 769 + INTEGER(IntKi), PARAMETER :: TwHt4FLzt = 770 + INTEGER(IntKi), PARAMETER :: TwHt5FLxt = 771 + INTEGER(IntKi), PARAMETER :: TwHt5FLyt = 772 + INTEGER(IntKi), PARAMETER :: TwHt5FLzt = 773 + INTEGER(IntKi), PARAMETER :: TwHt6FLxt = 774 + INTEGER(IntKi), PARAMETER :: TwHt6FLyt = 775 + INTEGER(IntKi), PARAMETER :: TwHt6FLzt = 776 + INTEGER(IntKi), PARAMETER :: TwHt7FLxt = 777 + INTEGER(IntKi), PARAMETER :: TwHt7FLyt = 778 + INTEGER(IntKi), PARAMETER :: TwHt7FLzt = 779 + INTEGER(IntKi), PARAMETER :: TwHt8FLxt = 780 + INTEGER(IntKi), PARAMETER :: TwHt8FLyt = 781 + INTEGER(IntKi), PARAMETER :: TwHt8FLzt = 782 + INTEGER(IntKi), PARAMETER :: TwHt9FLxt = 783 + INTEGER(IntKi), PARAMETER :: TwHt9FLyt = 784 + INTEGER(IntKi), PARAMETER :: TwHt9FLzt = 785 ! Internal Degrees of Freedom: - INTEGER(IntKi), PARAMETER :: Q_B1E1 = 783 - INTEGER(IntKi), PARAMETER :: Q_B2E1 = 784 - INTEGER(IntKi), PARAMETER :: Q_B3E1 = 785 - INTEGER(IntKi), PARAMETER :: Q_B1F1 = 786 - INTEGER(IntKi), PARAMETER :: Q_B2F1 = 787 - INTEGER(IntKi), PARAMETER :: Q_B3F1 = 788 - INTEGER(IntKi), PARAMETER :: Q_B1F2 = 789 - INTEGER(IntKi), PARAMETER :: Q_B2F2 = 790 - INTEGER(IntKi), PARAMETER :: Q_B3F2 = 791 - INTEGER(IntKi), PARAMETER :: Q_Teet = 792 - INTEGER(IntKi), PARAMETER :: Q_DrTr = 793 - INTEGER(IntKi), PARAMETER :: Q_GeAz = 794 - INTEGER(IntKi), PARAMETER :: Q_RFrl = 795 - INTEGER(IntKi), PARAMETER :: Q_TFrl = 796 - INTEGER(IntKi), PARAMETER :: Q_Yaw = 797 - INTEGER(IntKi), PARAMETER :: Q_TFA1 = 798 - INTEGER(IntKi), PARAMETER :: Q_TSS1 = 799 - INTEGER(IntKi), PARAMETER :: Q_TFA2 = 800 - INTEGER(IntKi), PARAMETER :: Q_TSS2 = 801 - INTEGER(IntKi), PARAMETER :: Q_Sg = 802 - INTEGER(IntKi), PARAMETER :: Q_Sw = 803 - INTEGER(IntKi), PARAMETER :: Q_Hv = 804 - INTEGER(IntKi), PARAMETER :: Q_R = 805 - INTEGER(IntKi), PARAMETER :: Q_P = 806 - INTEGER(IntKi), PARAMETER :: Q_Y = 807 - INTEGER(IntKi), PARAMETER :: QD_B1E1 = 808 - INTEGER(IntKi), PARAMETER :: QD_B2E1 = 809 - INTEGER(IntKi), PARAMETER :: QD_B3E1 = 810 - INTEGER(IntKi), PARAMETER :: QD_B1F1 = 811 - INTEGER(IntKi), PARAMETER :: QD_B2F1 = 812 - INTEGER(IntKi), PARAMETER :: QD_B3F1 = 813 - INTEGER(IntKi), PARAMETER :: QD_B1F2 = 814 - INTEGER(IntKi), PARAMETER :: QD_B2F2 = 815 - INTEGER(IntKi), PARAMETER :: QD_B3F2 = 816 - INTEGER(IntKi), PARAMETER :: QD_Teet = 817 - INTEGER(IntKi), PARAMETER :: QD_DrTr = 818 - INTEGER(IntKi), PARAMETER :: QD_GeAz = 819 - INTEGER(IntKi), PARAMETER :: QD_RFrl = 820 - INTEGER(IntKi), PARAMETER :: QD_TFrl = 821 - INTEGER(IntKi), PARAMETER :: QD_Yaw = 822 - INTEGER(IntKi), PARAMETER :: QD_TFA1 = 823 - INTEGER(IntKi), PARAMETER :: QD_TSS1 = 824 - INTEGER(IntKi), PARAMETER :: QD_TFA2 = 825 - INTEGER(IntKi), PARAMETER :: QD_TSS2 = 826 - INTEGER(IntKi), PARAMETER :: QD_Sg = 827 - INTEGER(IntKi), PARAMETER :: QD_Sw = 828 - INTEGER(IntKi), PARAMETER :: QD_Hv = 829 - INTEGER(IntKi), PARAMETER :: QD_R = 830 - INTEGER(IntKi), PARAMETER :: QD_P = 831 - INTEGER(IntKi), PARAMETER :: QD_Y = 832 - INTEGER(IntKi), PARAMETER :: QD2_B1E1 = 833 - INTEGER(IntKi), PARAMETER :: QD2_B2E1 = 834 - INTEGER(IntKi), PARAMETER :: QD2_B3E1 = 835 - INTEGER(IntKi), PARAMETER :: QD2_B1F1 = 836 - INTEGER(IntKi), PARAMETER :: QD2_B2F1 = 837 - INTEGER(IntKi), PARAMETER :: QD2_B3F1 = 838 - INTEGER(IntKi), PARAMETER :: QD2_B1F2 = 839 - INTEGER(IntKi), PARAMETER :: QD2_B2F2 = 840 - INTEGER(IntKi), PARAMETER :: QD2_B3F2 = 841 - INTEGER(IntKi), PARAMETER :: QD2_Teet = 842 - INTEGER(IntKi), PARAMETER :: QD2_DrTr = 843 - INTEGER(IntKi), PARAMETER :: QD2_GeAz = 844 - INTEGER(IntKi), PARAMETER :: QD2_RFrl = 845 - INTEGER(IntKi), PARAMETER :: QD2_TFrl = 846 - INTEGER(IntKi), PARAMETER :: QD2_Yaw = 847 - INTEGER(IntKi), PARAMETER :: QD2_TFA1 = 848 - INTEGER(IntKi), PARAMETER :: QD2_TSS1 = 849 - INTEGER(IntKi), PARAMETER :: QD2_TFA2 = 850 - INTEGER(IntKi), PARAMETER :: QD2_TSS2 = 851 - INTEGER(IntKi), PARAMETER :: QD2_Sg = 852 - INTEGER(IntKi), PARAMETER :: QD2_Sw = 853 - INTEGER(IntKi), PARAMETER :: QD2_Hv = 854 - INTEGER(IntKi), PARAMETER :: QD2_R = 855 - INTEGER(IntKi), PARAMETER :: QD2_P = 856 - INTEGER(IntKi), PARAMETER :: QD2_Y = 857 + INTEGER(IntKi), PARAMETER :: Q_B1E1 = 786 + INTEGER(IntKi), PARAMETER :: Q_B2E1 = 787 + INTEGER(IntKi), PARAMETER :: Q_B3E1 = 788 + INTEGER(IntKi), PARAMETER :: Q_B1F1 = 789 + INTEGER(IntKi), PARAMETER :: Q_B2F1 = 790 + INTEGER(IntKi), PARAMETER :: Q_B3F1 = 791 + INTEGER(IntKi), PARAMETER :: Q_B1F2 = 792 + INTEGER(IntKi), PARAMETER :: Q_B2F2 = 793 + INTEGER(IntKi), PARAMETER :: Q_B3F2 = 794 + INTEGER(IntKi), PARAMETER :: Q_Teet = 795 + INTEGER(IntKi), PARAMETER :: Q_DrTr = 796 + INTEGER(IntKi), PARAMETER :: Q_GeAz = 797 + INTEGER(IntKi), PARAMETER :: Q_RFrl = 798 + INTEGER(IntKi), PARAMETER :: Q_TFrl = 799 + INTEGER(IntKi), PARAMETER :: Q_Yaw = 800 + INTEGER(IntKi), PARAMETER :: Q_TFA1 = 801 + INTEGER(IntKi), PARAMETER :: Q_TSS1 = 802 + INTEGER(IntKi), PARAMETER :: Q_TFA2 = 803 + INTEGER(IntKi), PARAMETER :: Q_TSS2 = 804 + INTEGER(IntKi), PARAMETER :: Q_Sg = 805 + INTEGER(IntKi), PARAMETER :: Q_Sw = 806 + INTEGER(IntKi), PARAMETER :: Q_Hv = 807 + INTEGER(IntKi), PARAMETER :: Q_R = 808 + INTEGER(IntKi), PARAMETER :: Q_P = 809 + INTEGER(IntKi), PARAMETER :: Q_Y = 810 + INTEGER(IntKi), PARAMETER :: QD_B1E1 = 811 + INTEGER(IntKi), PARAMETER :: QD_B2E1 = 812 + INTEGER(IntKi), PARAMETER :: QD_B3E1 = 813 + INTEGER(IntKi), PARAMETER :: QD_B1F1 = 814 + INTEGER(IntKi), PARAMETER :: QD_B2F1 = 815 + INTEGER(IntKi), PARAMETER :: QD_B3F1 = 816 + INTEGER(IntKi), PARAMETER :: QD_B1F2 = 817 + INTEGER(IntKi), PARAMETER :: QD_B2F2 = 818 + INTEGER(IntKi), PARAMETER :: QD_B3F2 = 819 + INTEGER(IntKi), PARAMETER :: QD_Teet = 820 + INTEGER(IntKi), PARAMETER :: QD_DrTr = 821 + INTEGER(IntKi), PARAMETER :: QD_GeAz = 822 + INTEGER(IntKi), PARAMETER :: QD_RFrl = 823 + INTEGER(IntKi), PARAMETER :: QD_TFrl = 824 + INTEGER(IntKi), PARAMETER :: QD_Yaw = 825 + INTEGER(IntKi), PARAMETER :: QD_TFA1 = 826 + INTEGER(IntKi), PARAMETER :: QD_TSS1 = 827 + INTEGER(IntKi), PARAMETER :: QD_TFA2 = 828 + INTEGER(IntKi), PARAMETER :: QD_TSS2 = 829 + INTEGER(IntKi), PARAMETER :: QD_Sg = 830 + INTEGER(IntKi), PARAMETER :: QD_Sw = 831 + INTEGER(IntKi), PARAMETER :: QD_Hv = 832 + INTEGER(IntKi), PARAMETER :: QD_R = 833 + INTEGER(IntKi), PARAMETER :: QD_P = 834 + INTEGER(IntKi), PARAMETER :: QD_Y = 835 + INTEGER(IntKi), PARAMETER :: QD2_B1E1 = 836 + INTEGER(IntKi), PARAMETER :: QD2_B2E1 = 837 + INTEGER(IntKi), PARAMETER :: QD2_B3E1 = 838 + INTEGER(IntKi), PARAMETER :: QD2_B1F1 = 839 + INTEGER(IntKi), PARAMETER :: QD2_B2F1 = 840 + INTEGER(IntKi), PARAMETER :: QD2_B3F1 = 841 + INTEGER(IntKi), PARAMETER :: QD2_B1F2 = 842 + INTEGER(IntKi), PARAMETER :: QD2_B2F2 = 843 + INTEGER(IntKi), PARAMETER :: QD2_B3F2 = 844 + INTEGER(IntKi), PARAMETER :: QD2_Teet = 845 + INTEGER(IntKi), PARAMETER :: QD2_DrTr = 846 + INTEGER(IntKi), PARAMETER :: QD2_GeAz = 847 + INTEGER(IntKi), PARAMETER :: QD2_RFrl = 848 + INTEGER(IntKi), PARAMETER :: QD2_TFrl = 849 + INTEGER(IntKi), PARAMETER :: QD2_Yaw = 850 + INTEGER(IntKi), PARAMETER :: QD2_TFA1 = 851 + INTEGER(IntKi), PARAMETER :: QD2_TSS1 = 852 + INTEGER(IntKi), PARAMETER :: QD2_TFA2 = 853 + INTEGER(IntKi), PARAMETER :: QD2_TSS2 = 854 + INTEGER(IntKi), PARAMETER :: QD2_Sg = 855 + INTEGER(IntKi), PARAMETER :: QD2_Sw = 856 + INTEGER(IntKi), PARAMETER :: QD2_Hv = 857 + INTEGER(IntKi), PARAMETER :: QD2_R = 858 + INTEGER(IntKi), PARAMETER :: QD2_P = 859 + INTEGER(IntKi), PARAMETER :: QD2_Y = 860 ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 857 + INTEGER(IntKi), PARAMETER :: MaxOutPts = 860 !End of code generated by Matlab script ! =================================================================================================== @@ -3247,12 +3252,15 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile INTEGER(IntKi) :: ErrStat2 ! Temporary Error status LOGICAL :: Echo ! Determines if an echo file should be written CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'ReadPrimaryFile' 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") - + ! Initialize some variables: + ErrStat = ErrID_None + ErrMsg = "" Echo = .FALSE. UnEc = -1 ! Echo file not opened, yet CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. @@ -3303,6 +3311,10 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Read the lines up/including to the "Echo" simulation control variable ! If echo is FALSE, don't write these lines to the echo file. @@ -4320,6 +4332,67 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that this section does not exist. + ErrMsg_NoAllBldNdOuts='Nodal outputs section of ElastoDyn input file not found or improperly formatted.' + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: In a future release, allow this to be an array of N blade numbers (change BldNd_BladesOut to an array if we do that). + ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Which blades to output for: will add this at some point + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF !---------------------- END OF FILE ----------------------------------------- call cleanup() @@ -5182,11 +5255,12 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, ErrStat, Er END IF - ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings - CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName ) - IF ( FmtWidth /= ChanLen ) CALL SetErrStat(ErrID_Warn, 'OutFmt produces a column width of '//TRIM(Num2LStr(FmtWidth))//& - ' instead of '//TRIM(Num2LStr(ChanLen))//' characters.',ErrStat,ErrMsg,RoutineName ) + !bjj: since ED doesn't actually use OutFmt at this point, I'm going to remove this check and warning message + !!!! ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings + !!!!CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) + !!!!CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !!!!IF ( FmtWidth /= ChanLen ) CALL SetErrStat(ErrID_Warn, 'OutFmt produces a column width of '//TRIM(Num2LStr(FmtWidth))//& + !!!! ' instead of '//TRIM(Num2LStr(ChanLen))//' characters.',ErrStat,ErrMsg,RoutineName ) RETURN diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index a1ac31082a..ed6dc2c2b9 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -40,11 +40,14 @@ typedef ^ InitOutputType ReKi TwrHNodes {:} - - "Location of variable-spaced tow typedef ^ InitOutputType ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" typedef ^ InitOutputType ReKi TwrBasePos {3} - - "initial position of the tower base (for SrvD)" m typedef ^ InitOutputType ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m +typedef ^ InitOutputType ReKi RotSpeed - - - "Initial or fixed rotor speed" rad/s +typedef ^ InitOutputType LOGICAL isFixed_GenDOF - - - "whether the generator is fixed or free" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - +typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - @@ -269,6 +272,12 @@ typedef ^ ED_InputFile ReKi TFrlUSDmp - - - "Tail-furl up-stop damping constant" typedef ^ ED_InputFile ReKi TFrlDSDmp - - - "Tail-furl down-stop damping constant" N-m/(rad/s) typedef ^ ED_InputFile IntKi method - - - "Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4])" - +# ..... ED_AllBldNdOuts compile option ............................................................................................ +typedef ^ ED_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (ED_AllBldNdOuts)" - +#typedef ^ ED_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - # ..... Internal data types ....................................................................................................... @@ -796,6 +805,13 @@ typedef ^ ParameterType ReKi PtfmCMxt - - - "Downwind distance from the ground [ typedef ^ ParameterType ReKi PtfmCMyt - - - "Lateral distance from the ground [onshore] or MSL [offshore] to the platform CM" meters typedef ^ ParameterType LOGICAL BD4Blades - - - "flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false)" - typedef ^ ParameterType LOGICAL UseAD14 - - - "flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14." - +# .... ED_AllBlNds option ........................................................................................................ +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +#typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - + typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" @@ -811,7 +827,7 @@ typedef ^ InputType MeshType NacelleLoads - - - "From ServoDyn/TMD: loads on the # Define inputs that are not on a mesh here: typedef ^ InputType ReKi TwrAddedMass {:}{:}{:} - - "6-by-6 added mass matrix of the tower elements, per unit length-bjj: place on a mesh" "per unit length" typedef ^ InputType ReKi PtfmAddedMass {6}{6} - - "Platform added mass matrix" "kg, kg-m, kg-m^2" -typedef ^ InputType ReKi BlPitchCom {:} - - "Commanded blade pitch angles" radians +typedef ^ InputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians typedef ^ InputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m typedef ^ InputType ReKi GenTrq - - - "Electrical generator torque" N-m typedef ^ InputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m @@ -831,18 +847,18 @@ typedef ^ OutputType MeshType TowerBaseMotion14 - - - "For AeroDyn 14: motions o # Define outputs that are not on this mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitch {:} - - "Current blade pitch angles" radians -typedef ^ OutputType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ OutputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians +typedef ^ OutputType ReKi Yaw - - 2pi "Current nacelle yaw" radians typedef ^ OutputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s typedef ^ OutputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s typedef ^ OutputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s typedef ^ OutputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s typedef ^ OutputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ OutputType ReKi YawAngle - - - "Yaw angle to be used for yaw error calculations" radians +typedef ^ OutputType ReKi YawAngle - - 2pi "Yaw angle to be used for yaw error calculations" radians typedef ^ OutputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m typedef ^ OutputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 typedef ^ OutputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 -typedef ^ OutputType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians +typedef ^ OutputType ReKi LSSTipPxa - - 2pi "Rotor azimuth angle (position)" radians typedef ^ OutputType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m typedef ^ OutputType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m typedef ^ OutputType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index ba6ff761e6..35338dc227 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -60,11 +60,14 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(1:6) :: PlatformPos !< Initial platform position (6 DOFs) [-] REAL(ReKi) , DIMENSION(1:3) :: TwrBasePos !< initial position of the tower base (for SrvD) [m] REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] + LOGICAL :: isFixed_GenDOF !< whether the generator is fixed or free [-] 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 [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] END TYPE ED_InitOutputType @@ -285,6 +288,10 @@ MODULE ElastoDyn_Types REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [N-m/(rad/s)] REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [N-m/(rad/s)] INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= ! ========= ED_CoordSys ======= @@ -800,6 +807,10 @@ MODULE ElastoDyn_Types REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground [onshore] or MSL [offshore] to the platform CM [meters] LOGICAL :: BD4Blades !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] LOGICAL :: UseAD14 !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] INTEGER(IntKi) , 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) [-] @@ -965,22 +976,22 @@ SUBROUTINE ED_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ADInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompElast , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ADInputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompElast, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ED_PackInitInput SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -996,12 +1007,6 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1020,22 +1025,22 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ADInputFile) - OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompElast = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ADInputFile) + OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompElast = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompElast) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ED_UnPackInitInput SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1125,6 +1130,8 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos DstInitOutputData%TwrBasePos = SrcInitOutputData%TwrBasePos DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) @@ -1185,6 +1192,18 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er END IF DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x ENDIF +IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) + i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN + ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x +ENDIF IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) @@ -1251,6 +1270,9 @@ SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN DEALLOCATE(InitOutputData%RotFrame_x) ENDIF +IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN + DEALLOCATE(InitOutputData%DerivOrder_x) +ENDIF IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN DEALLOCATE(InitOutputData%RotFrame_u) ENDIF @@ -1346,6 +1368,8 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos Re_BufSz = Re_BufSz + SIZE(InData%TwrBasePos) ! TwrBasePos Re_BufSz = Re_BufSz + 1 ! HubRad + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Int_BufSz = Int_BufSz + 1 ! isFixed_GenDOF Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no IF ( ALLOCATED(InData%LinNames_y) ) THEN Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension @@ -1371,6 +1395,11 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x END IF + Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no + IF ( ALLOCATED(InData%DerivOrder_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x + END IF Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no IF ( ALLOCATED(InData%RotFrame_u) ) THEN Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension @@ -1418,12 +1447,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1435,12 +1464,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1470,10 +1499,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1484,17 +1513,19 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BldRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1505,8 +1536,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldRNodes))-1 ) = PACK(InData%BldRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldRNodes) + DO i1 = LBOUND(InData%BldRNodes,1), UBOUND(InData%BldRNodes,1) + ReKiBuf(Re_Xferred) = InData%BldRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1518,15 +1551,25 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrHNodes))-1 ) = PACK(InData%TwrHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrHNodes) + DO i1 = LBOUND(InData%TwrHNodes,1), UBOUND(InData%TwrHNodes,1) + ReKiBuf(Re_Xferred) = InData%TwrHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PlatformPos))-1 ) = PACK(InData%PlatformPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PlatformPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrBasePos))-1 ) = PACK(InData%TwrBasePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrBasePos) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) + ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrBasePos,1), UBOUND(InData%TwrBasePos,1) + ReKiBuf(Re_Xferred) = InData%TwrBasePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%isFixed_GenDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1537,12 +1580,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1554,12 +1597,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1571,12 +1614,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1588,8 +1631,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + 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 @@ -1601,8 +1646,25 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1614,8 +1676,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1627,8 +1691,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackInitOutput @@ -1645,12 +1711,6 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1678,19 +1738,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1705,19 +1758,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1759,10 +1805,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1776,24 +1822,19 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1807,15 +1848,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldRNodes)>0) OutData%BldRNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldRNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldRNodes,1), UBOUND(OutData%BldRNodes,1) + OutData%BldRNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -1830,40 +1866,29 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrHNodes)>0) OutData%TwrHNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrHNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrHNodes,1), UBOUND(OutData%TwrHNodes,1) + OutData%TwrHNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%PlatformPos,1) i1_u = UBOUND(OutData%PlatformPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PlatformPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PlatformPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PlatformPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PlatformPos,1), UBOUND(OutData%PlatformPos,1) + OutData%PlatformPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrBasePos,1) i1_u = UBOUND(OutData%TwrBasePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrBasePos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrBasePos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrBasePos) - DEALLOCATE(mask1) - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TwrBasePos,1), UBOUND(OutData%TwrBasePos,1) + OutData%TwrBasePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%isFixed_GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%isFixed_GenDOF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1877,19 +1902,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1904,19 +1922,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1931,19 +1942,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1958,15 +1962,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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 @@ -1981,15 +1980,28 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) + ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2004,15 +2016,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -2027,15 +2034,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackInitOutput @@ -2537,8 +2539,8 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlInpSt + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlFract) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2549,8 +2551,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFract,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlFract)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlFract))-1 ) = PACK(InData%BlFract,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlFract) + DO i1 = LBOUND(InData%BlFract,1), UBOUND(InData%BlFract,1) + ReKiBuf(Re_Xferred) = InData%BlFract(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PitchAx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2562,8 +2566,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitchAx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitchAx))-1 ) = PACK(InData%PitchAx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitchAx) + DO i1 = LBOUND(InData%PitchAx,1), UBOUND(InData%PitchAx,1) + ReKiBuf(Re_Xferred) = InData%PitchAx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StrcTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2575,8 +2581,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrcTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StrcTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StrcTwst))-1 ) = PACK(InData%StrcTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StrcTwst) + DO i1 = LBOUND(InData%StrcTwst,1), UBOUND(InData%StrcTwst,1) + ReKiBuf(Re_Xferred) = InData%StrcTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2588,8 +2596,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BMassDen))-1 ) = PACK(InData%BMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BMassDen) + DO i1 = LBOUND(InData%BMassDen,1), UBOUND(InData%BMassDen,1) + ReKiBuf(Re_Xferred) = InData%BMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2601,8 +2611,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpStff))-1 ) = PACK(InData%FlpStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpStff) + DO i1 = LBOUND(InData%FlpStff,1), UBOUND(InData%FlpStff,1) + ReKiBuf(Re_Xferred) = InData%FlpStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2614,8 +2626,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgStff))-1 ) = PACK(InData%EdgStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgStff) + DO i1 = LBOUND(InData%EdgStff,1), UBOUND(InData%EdgStff,1) + ReKiBuf(Re_Xferred) = InData%EdgStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GJStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2627,8 +2641,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GJStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GJStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GJStff))-1 ) = PACK(InData%GJStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GJStff) + DO i1 = LBOUND(InData%GJStff,1), UBOUND(InData%GJStff,1) + ReKiBuf(Re_Xferred) = InData%GJStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EAStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2640,8 +2656,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAStff))-1 ) = PACK(InData%EAStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAStff) + DO i1 = LBOUND(InData%EAStff,1), UBOUND(InData%EAStff,1) + ReKiBuf(Re_Xferred) = InData%EAStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Alpha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2653,8 +2671,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Alpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Alpha))-1 ) = PACK(InData%Alpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Alpha) + DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) + ReKiBuf(Re_Xferred) = InData%Alpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2666,8 +2686,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpIner))-1 ) = PACK(InData%FlpIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpIner) + DO i1 = LBOUND(InData%FlpIner,1), UBOUND(InData%FlpIner,1) + ReKiBuf(Re_Xferred) = InData%FlpIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2679,8 +2701,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgIner))-1 ) = PACK(InData%EdgIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgIner) + DO i1 = LBOUND(InData%EdgIner,1), UBOUND(InData%EdgIner,1) + ReKiBuf(Re_Xferred) = InData%EdgIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PrecrvRef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2692,8 +2716,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrecrvRef,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PrecrvRef)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PrecrvRef))-1 ) = PACK(InData%PrecrvRef,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PrecrvRef) + DO i1 = LBOUND(InData%PrecrvRef,1), UBOUND(InData%PrecrvRef,1) + ReKiBuf(Re_Xferred) = InData%PrecrvRef(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PreswpRef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2705,8 +2731,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreswpRef,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PreswpRef)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PreswpRef))-1 ) = PACK(InData%PreswpRef,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PreswpRef) + DO i1 = LBOUND(InData%PreswpRef,1), UBOUND(InData%PreswpRef,1) + ReKiBuf(Re_Xferred) = InData%PreswpRef(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2718,8 +2746,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpcgOf))-1 ) = PACK(InData%FlpcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpcgOf) + DO i1 = LBOUND(InData%FlpcgOf,1), UBOUND(InData%FlpcgOf,1) + ReKiBuf(Re_Xferred) = InData%FlpcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2731,8 +2761,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgcgOf))-1 ) = PACK(InData%EdgcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgcgOf) + DO i1 = LBOUND(InData%EdgcgOf,1), UBOUND(InData%EdgcgOf,1) + ReKiBuf(Re_Xferred) = InData%EdgcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpEAOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2744,8 +2776,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpEAOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpEAOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpEAOf))-1 ) = PACK(InData%FlpEAOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpEAOf) + DO i1 = LBOUND(InData%FlpEAOf,1), UBOUND(InData%FlpEAOf,1) + ReKiBuf(Re_Xferred) = InData%FlpEAOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgEAOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2757,15 +2791,23 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgEAOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgEAOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgEAOf))-1 ) = PACK(InData%EdgEAOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgEAOf) + DO i1 = LBOUND(InData%EdgEAOf,1), UBOUND(InData%EdgEAOf,1) + ReKiBuf(Re_Xferred) = InData%EdgEAOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFlDmp))-1 ) = PACK(InData%BldFlDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFlDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdDmp))-1 ) = PACK(InData%BldEdDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlStTunr))-1 ) = PACK(InData%FlStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlStTunr) + DO i1 = LBOUND(InData%BldFlDmp,1), UBOUND(InData%BldFlDmp,1) + ReKiBuf(Re_Xferred) = InData%BldFlDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BldEdDmp,1), UBOUND(InData%BldEdDmp,1) + ReKiBuf(Re_Xferred) = InData%BldEdDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FlStTunr,1), UBOUND(InData%FlStTunr,1) + ReKiBuf(Re_Xferred) = InData%FlStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2776,8 +2818,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl1Sh))-1 ) = PACK(InData%BldFl1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl1Sh) + DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2789,8 +2833,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl2Sh))-1 ) = PACK(InData%BldFl2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl2Sh) + DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2802,8 +2848,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEdgSh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdgSh))-1 ) = PACK(InData%BldEdgSh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdgSh) + DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) + ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackBladeInputData @@ -2820,12 +2868,6 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2840,8 +2882,8 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NBlInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NBlInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFract not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2855,15 +2897,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlFract)>0) OutData%BlFract = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlFract))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlFract) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlFract,1), UBOUND(OutData%BlFract,1) + OutData%BlFract(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAx not allocated Int_Xferred = Int_Xferred + 1 @@ -2878,15 +2915,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PitchAx)>0) OutData%PitchAx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitchAx))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitchAx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PitchAx,1), UBOUND(OutData%PitchAx,1) + OutData%PitchAx(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrcTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -2901,15 +2933,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StrcTwst)>0) OutData%StrcTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StrcTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StrcTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StrcTwst,1), UBOUND(OutData%StrcTwst,1) + OutData%StrcTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -2924,15 +2951,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BMassDen)>0) OutData%BMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BMassDen,1), UBOUND(OutData%BMassDen,1) + OutData%BMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpStff not allocated Int_Xferred = Int_Xferred + 1 @@ -2947,15 +2969,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpStff)>0) OutData%FlpStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpStff,1), UBOUND(OutData%FlpStff,1) + OutData%FlpStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgStff not allocated Int_Xferred = Int_Xferred + 1 @@ -2970,15 +2987,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgStff)>0) OutData%EdgStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgStff,1), UBOUND(OutData%EdgStff,1) + OutData%EdgStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GJStff not allocated Int_Xferred = Int_Xferred + 1 @@ -2993,15 +3005,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GJStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GJStff)>0) OutData%GJStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GJStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GJStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GJStff,1), UBOUND(OutData%GJStff,1) + OutData%GJStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3016,15 +3023,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EAStff)>0) OutData%EAStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EAStff,1), UBOUND(OutData%EAStff,1) + OutData%EAStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha not allocated Int_Xferred = Int_Xferred + 1 @@ -3039,15 +3041,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Alpha)>0) OutData%Alpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Alpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Alpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) + OutData%Alpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpIner not allocated Int_Xferred = Int_Xferred + 1 @@ -3062,15 +3059,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpIner)>0) OutData%FlpIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpIner,1), UBOUND(OutData%FlpIner,1) + OutData%FlpIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgIner not allocated Int_Xferred = Int_Xferred + 1 @@ -3085,15 +3077,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgIner)>0) OutData%EdgIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgIner,1), UBOUND(OutData%EdgIner,1) + OutData%EdgIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrecrvRef not allocated Int_Xferred = Int_Xferred + 1 @@ -3108,15 +3095,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrecrvRef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PrecrvRef)>0) OutData%PrecrvRef = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PrecrvRef))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PrecrvRef) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PrecrvRef,1), UBOUND(OutData%PrecrvRef,1) + OutData%PrecrvRef(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreswpRef not allocated Int_Xferred = Int_Xferred + 1 @@ -3131,15 +3113,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreswpRef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PreswpRef)>0) OutData%PreswpRef = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PreswpRef))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PreswpRef) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PreswpRef,1), UBOUND(OutData%PreswpRef,1) + OutData%PreswpRef(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3154,15 +3131,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpcgOf)>0) OutData%FlpcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpcgOf,1), UBOUND(OutData%FlpcgOf,1) + OutData%FlpcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3177,15 +3149,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgcgOf)>0) OutData%EdgcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgcgOf,1), UBOUND(OutData%EdgcgOf,1) + OutData%EdgcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpEAOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3200,15 +3167,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpEAOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpEAOf)>0) OutData%FlpEAOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpEAOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpEAOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpEAOf,1), UBOUND(OutData%FlpEAOf,1) + OutData%FlpEAOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgEAOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3223,49 +3185,29 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgEAOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgEAOf)>0) OutData%EdgEAOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgEAOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgEAOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgEAOf,1), UBOUND(OutData%EdgEAOf,1) + OutData%EdgEAOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%BldFlDmp,1) i1_u = UBOUND(OutData%BldFlDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldFlDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFlDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFlDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFlDmp,1), UBOUND(OutData%BldFlDmp,1) + OutData%BldFlDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%BldEdDmp,1) i1_u = UBOUND(OutData%BldEdDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldEdDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldEdDmp,1), UBOUND(OutData%BldEdDmp,1) + OutData%BldEdDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FlStTunr,1) i1_u = UBOUND(OutData%FlStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FlStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlStTunr,1), UBOUND(OutData%FlStTunr,1) + OutData%FlStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3279,15 +3221,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldFl1Sh)>0) OutData%BldFl1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) + OutData%BldFl1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -3302,15 +3239,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldFl2Sh)>0) OutData%BldFl2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) + OutData%BldFl2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated Int_Xferred = Int_Xferred + 1 @@ -3325,15 +3257,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldEdgSh)>0) OutData%BldEdgSh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdgSh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdgSh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) + OutData%BldEdgSh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackBladeInputData @@ -3489,8 +3416,8 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3501,8 +3428,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodes))-1 ) = PACK(InData%RNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodes) + DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) + ReKiBuf(Re_Xferred) = InData%RNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3514,8 +3443,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroTwst))-1 ) = PACK(InData%AeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroTwst) + DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) + ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Chord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3527,8 +3458,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Chord))-1 ) = PACK(InData%Chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Chord) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackBladeMeshInputData @@ -3545,12 +3478,6 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3565,8 +3492,8 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%BldNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%BldNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3580,15 +3507,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodes)>0) OutData%RNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) + OutData%RNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -3603,15 +3525,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AeroTwst)>0) OutData%AeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) + OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated Int_Xferred = Int_Xferred + 1 @@ -3626,15 +3543,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Chord)>0) OutData%Chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Chord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Chord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackBladeMeshInputData @@ -4059,6 +3971,21 @@ SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp DstInputFileData%method = SrcInputFileData%method + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE ED_CopyInputFile SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -4135,6 +4062,9 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%TwSScgOf)) THEN DEALLOCATE(InputFileData%TwSScgOf) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) ENDIF END SUBROUTINE ED_DestroyInputFile @@ -4468,6 +4398,14 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp Int_BufSz = Int_BufSz + 1 ! method + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4495,91 +4433,93 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FlapDOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FlapDOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EdgeDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TeetDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DrTrDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%YawDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwFADOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwFADOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwSSDOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwSSDOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OoPDefl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IPDefl - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF1, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF2, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EdgeDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TeetDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DrTrDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%YawDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OoPDefl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IPDefl + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) + Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDefl - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Azimuth - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TTDspFA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TTDspSS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmSurge - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmSway - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmHeave - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRoll - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYaw - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TeetDefl + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Azimuth + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TTDspFA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TTDspSS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmSurge + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmSway + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmHeave + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRoll + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYaw + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PreCone) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4590,49 +4530,51 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreCone,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PreCone)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PreCone))-1 ) = PACK(InData%PreCone,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PreCone) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delta3 - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Twr2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PreCone,1), UBOUND(InData%PreCone,1) + ReKiBuf(Re_Xferred) = InData%PreCone(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HubCM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UndSling + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delta3 + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimB1Up + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OverHang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftGagL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Twr2Shft + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBsHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMyt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMzt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4643,31 +4585,33 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TipMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TipMass))-1 ) = PACK(InData%TipMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TipMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BldNodes - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) + ReKiBuf(Re_Xferred) = InData%TipMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HubMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BldNodes + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpBlMesh) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4750,58 +4694,62 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Furling , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DecFact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwrGagNd))-1 ) = PACK(InData%TwrGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwrGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BldGagNd))-1 ) = PACK(InData%BldGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BldGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TeetMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmpP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBRatio + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Furling, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DecFact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwGages + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) + IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NBlGages + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) + IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4812,23 +4760,31 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwInpSt - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrFADmp))-1 ) = PACK(InData%TwrFADmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrFADmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrSSDmp))-1 ) = PACK(InData%TwrSSDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrSSDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAStTunr))-1 ) = PACK(InData%FAStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAStTunr) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SSStTunr))-1 ) = PACK(InData%SSStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SSStTunr) + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NTwInpSt + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrFADmp,1), UBOUND(InData%TwrFADmp,1) + ReKiBuf(Re_Xferred) = InData%TwrFADmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrSSDmp,1), UBOUND(InData%TwrSSDmp,1) + ReKiBuf(Re_Xferred) = InData%TwrSSDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FAStTunr,1), UBOUND(InData%FAStTunr,1) + ReKiBuf(Re_Xferred) = InData%FAStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SSStTunr,1), UBOUND(InData%SSStTunr,1) + ReKiBuf(Re_Xferred) = InData%SSStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%HtFract) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4839,8 +4795,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HtFract,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HtFract)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HtFract))-1 ) = PACK(InData%HtFract,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HtFract) + DO i1 = LBOUND(InData%HtFract,1), UBOUND(InData%HtFract,1) + ReKiBuf(Re_Xferred) = InData%HtFract(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4852,8 +4810,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TMassDen))-1 ) = PACK(InData%TMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TMassDen) + DO i1 = LBOUND(InData%TMassDen,1), UBOUND(InData%TMassDen,1) + ReKiBuf(Re_Xferred) = InData%TMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4865,8 +4825,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAStif))-1 ) = PACK(InData%TwFAStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAStif) + DO i1 = LBOUND(InData%TwFAStif,1), UBOUND(InData%TwFAStif,1) + ReKiBuf(Re_Xferred) = InData%TwFAStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4878,8 +4840,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSStif))-1 ) = PACK(InData%TwSSStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSStif) + DO i1 = LBOUND(InData%TwSSStif,1), UBOUND(InData%TwSSStif,1) + ReKiBuf(Re_Xferred) = InData%TwSSStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAM1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4891,8 +4855,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAM1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAM1Sh))-1 ) = PACK(InData%TwFAM1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAM1Sh) + DO i1 = LBOUND(InData%TwFAM1Sh,1), UBOUND(InData%TwFAM1Sh,1) + ReKiBuf(Re_Xferred) = InData%TwFAM1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAM2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4904,8 +4870,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAM2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAM2Sh))-1 ) = PACK(InData%TwFAM2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAM2Sh) + DO i1 = LBOUND(InData%TwFAM2Sh,1), UBOUND(InData%TwFAM2Sh,1) + ReKiBuf(Re_Xferred) = InData%TwFAM2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSM1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4917,8 +4885,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSM1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSM1Sh))-1 ) = PACK(InData%TwSSM1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSM1Sh) + DO i1 = LBOUND(InData%TwSSM1Sh,1), UBOUND(InData%TwSSM1Sh,1) + ReKiBuf(Re_Xferred) = InData%TwSSM1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSM2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4930,8 +4900,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSM2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSM2Sh))-1 ) = PACK(InData%TwSSM2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSM2Sh) + DO i1 = LBOUND(InData%TwSSM2Sh,1), UBOUND(InData%TwSSM2Sh,1) + ReKiBuf(Re_Xferred) = InData%TwSSM2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwGJStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4943,8 +4915,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwGJStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwGJStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwGJStif))-1 ) = PACK(InData%TwGJStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwGJStif) + DO i1 = LBOUND(InData%TwGJStif,1), UBOUND(InData%TwGJStif,1) + ReKiBuf(Re_Xferred) = InData%TwGJStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwEAStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4956,8 +4930,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwEAStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwEAStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwEAStif))-1 ) = PACK(InData%TwEAStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwEAStif) + DO i1 = LBOUND(InData%TwEAStif,1), UBOUND(InData%TwEAStif,1) + ReKiBuf(Re_Xferred) = InData%TwEAStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4969,8 +4945,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAIner))-1 ) = PACK(InData%TwFAIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAIner) + DO i1 = LBOUND(InData%TwFAIner,1), UBOUND(InData%TwFAIner,1) + ReKiBuf(Re_Xferred) = InData%TwFAIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4982,8 +4960,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSIner))-1 ) = PACK(InData%TwSSIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSIner) + DO i1 = LBOUND(InData%TwSSIner,1), UBOUND(InData%TwSSIner,1) + ReKiBuf(Re_Xferred) = InData%TwSSIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4995,8 +4975,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAcgOf))-1 ) = PACK(InData%TwFAcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAcgOf) + DO i1 = LBOUND(InData%TwFAcgOf,1), UBOUND(InData%TwFAcgOf,1) + ReKiBuf(Re_Xferred) = InData%TwFAcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSScgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5008,131 +4990,158 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSScgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSScgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSScgOf))-1 ) = PACK(InData%TwSScgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSScgOf) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RFrlDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TFrlDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TailFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinBank - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwSScgOf,1), UBOUND(InData%TwSScgOf,1) + ReKiBuf(Re_Xferred) = InData%TwSScgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%RFrlDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TFrlDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotFurl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TailFurl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw2Shft + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinBank + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlIner + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackInputFile SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5148,12 +5157,6 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5168,48 +5171,48 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FlapDOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FlapDOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%EdgeDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DrTrDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%YawDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OoPDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IPDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FlapDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF1) + Int_Xferred = Int_Xferred + 1 + OutData%FlapDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF2) + Int_Xferred = Int_Xferred + 1 + OutData%EdgeDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%EdgeDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TeetDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TeetDOF) + Int_Xferred = Int_Xferred + 1 + OutData%DrTrDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DrTrDOF) + Int_Xferred = Int_Xferred + 1 + OutData%GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenDOF) + Int_Xferred = Int_Xferred + 1 + OutData%YawDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%YawDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TwFADOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF1) + Int_Xferred = Int_Xferred + 1 + OutData%TwFADOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF2) + Int_Xferred = Int_Xferred + 1 + OutData%TwSSDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF1) + Int_Xferred = Int_Xferred + 1 + OutData%TwSSDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSgDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYDOF) + Int_Xferred = Int_Xferred + 1 + OutData%OoPDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IPDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5223,46 +5226,41 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%TeetDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspFA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspSS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSurge = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSway = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmHeave = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRoll = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TipRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TeetDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Azimuth = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TTDspFA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TTDspSS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmSurge = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmSway = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmHeave = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRoll = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TipRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreCone not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5276,56 +5274,51 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PreCone)>0) OutData%PreCone = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PreCone))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PreCone) - DEALLOCATE(mask1) - END IF - OutData%HubCM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delta3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverHang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftGagL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Twr2Shft = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PreCone,1), UBOUND(OutData%PreCone,1) + OutData%PreCone(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HubCM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UndSling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delta3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%OverHang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftGagL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Twr2Shft = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBsHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMyt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5339,38 +5332,33 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TipMass)>0) OutData%TipMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TipMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TipMass) - DEALLOCATE(mask1) - END IF - OutData%HubMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BldNodes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) + OutData%TipMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HubMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BldNodes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBlMesh not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5483,76 +5471,66 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%TeetMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDmpP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Furling = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DecFact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TeetMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TeetDmpP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Furling = TRANSFER(IntKiBuf(Int_Xferred), OutData%Furling) + Int_Xferred = Int_Xferred + 1 + OutData%TwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DecFact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwrGagNd,1) i1_u = UBOUND(OutData%TwrGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwrGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwrGagNd) - DEALLOCATE(mask1) - OutData%NBlGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) + OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NBlGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BldGagNd,1) i1_u = UBOUND(OutData%BldGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BldGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BldGagNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) + OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5566,66 +5544,39 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%NTwInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NTwInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwrFADmp,1) i1_u = UBOUND(OutData%TwrFADmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrFADmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrFADmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrFADmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrFADmp,1), UBOUND(OutData%TwrFADmp,1) + OutData%TwrFADmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrSSDmp,1) i1_u = UBOUND(OutData%TwrSSDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrSSDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrSSDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrSSDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrSSDmp,1), UBOUND(OutData%TwrSSDmp,1) + OutData%TwrSSDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FAStTunr,1) i1_u = UBOUND(OutData%FAStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FAStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FAStTunr,1), UBOUND(OutData%FAStTunr,1) + OutData%FAStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SSStTunr,1) i1_u = UBOUND(OutData%SSStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SSStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SSStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SSStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SSStTunr,1), UBOUND(OutData%SSStTunr,1) + OutData%SSStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HtFract not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5639,15 +5590,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HtFract)>0) OutData%HtFract = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HtFract))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HtFract) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HtFract,1), UBOUND(OutData%HtFract,1) + OutData%HtFract(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5662,15 +5608,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TMassDen)>0) OutData%TMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TMassDen,1), UBOUND(OutData%TMassDen,1) + OutData%TMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5685,15 +5626,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAStif)>0) OutData%TwFAStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAStif,1), UBOUND(OutData%TwFAStif,1) + OutData%TwFAStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5708,15 +5644,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSStif)>0) OutData%TwSSStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSStif,1), UBOUND(OutData%TwSSStif,1) + OutData%TwSSStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5731,15 +5662,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAM1Sh)>0) OutData%TwFAM1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAM1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAM1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAM1Sh,1), UBOUND(OutData%TwFAM1Sh,1) + OutData%TwFAM1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5754,15 +5680,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAM2Sh)>0) OutData%TwFAM2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAM2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAM2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAM2Sh,1), UBOUND(OutData%TwFAM2Sh,1) + OutData%TwFAM2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5777,15 +5698,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSM1Sh)>0) OutData%TwSSM1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSM1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSM1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSM1Sh,1), UBOUND(OutData%TwSSM1Sh,1) + OutData%TwSSM1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5800,15 +5716,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSM2Sh)>0) OutData%TwSSM2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSM2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSM2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSM2Sh,1), UBOUND(OutData%TwSSM2Sh,1) + OutData%TwSSM2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwGJStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5823,15 +5734,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwGJStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwGJStif)>0) OutData%TwGJStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwGJStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwGJStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwGJStif,1), UBOUND(OutData%TwGJStif,1) + OutData%TwGJStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwEAStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5846,15 +5752,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwEAStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwEAStif)>0) OutData%TwEAStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwEAStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwEAStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwEAStif,1), UBOUND(OutData%TwEAStif,1) + OutData%TwEAStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAIner not allocated Int_Xferred = Int_Xferred + 1 @@ -5869,15 +5770,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAIner)>0) OutData%TwFAIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAIner,1), UBOUND(OutData%TwFAIner,1) + OutData%TwFAIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSIner not allocated Int_Xferred = Int_Xferred + 1 @@ -5892,15 +5788,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSIner)>0) OutData%TwSSIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSIner,1), UBOUND(OutData%TwSSIner,1) + OutData%TwSSIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -5915,15 +5806,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAcgOf)>0) OutData%TwFAcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAcgOf,1), UBOUND(OutData%TwFAcgOf,1) + OutData%TwFAcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSScgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -5938,138 +5824,161 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSScgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSScgOf)>0) OutData%TwSScgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSScgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSScgOf) - DEALLOCATE(mask1) - END IF - OutData%RFrlDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RotFurl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TailFurl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw2Shft = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinBank = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwSScgOf,1), UBOUND(OutData%TwSScgOf,1) + OutData%TwSScgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%RFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%RFrlDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFrlDOF) + Int_Xferred = Int_Xferred + 1 + OutData%RotFurl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TailFurl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw2Shft = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinBank = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackInputFile SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) @@ -6648,48 +6557,90 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a1))-1 ) = PACK(InData%a1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a2))-1 ) = PACK(InData%a2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a3))-1 ) = PACK(InData%a3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b1))-1 ) = PACK(InData%b1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b2))-1 ) = PACK(InData%b2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b3))-1 ) = PACK(InData%b3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c1))-1 ) = PACK(InData%c1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c2))-1 ) = PACK(InData%c2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c3))-1 ) = PACK(InData%c3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d1))-1 ) = PACK(InData%d1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d2))-1 ) = PACK(InData%d2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d3))-1 ) = PACK(InData%d3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e1))-1 ) = PACK(InData%e1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e2))-1 ) = PACK(InData%e2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e3))-1 ) = PACK(InData%e3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f1))-1 ) = PACK(InData%f1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f2))-1 ) = PACK(InData%f2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f3))-1 ) = PACK(InData%f3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g1))-1 ) = PACK(InData%g1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g2))-1 ) = PACK(InData%g2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g3))-1 ) = PACK(InData%g3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g3) + DO i1 = LBOUND(InData%a1,1), UBOUND(InData%a1,1) + DbKiBuf(Db_Xferred) = InData%a1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a2,1), UBOUND(InData%a2,1) + DbKiBuf(Db_Xferred) = InData%a2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a3,1), UBOUND(InData%a3,1) + DbKiBuf(Db_Xferred) = InData%a3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b1,1), UBOUND(InData%b1,1) + DbKiBuf(Db_Xferred) = InData%b1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b2,1), UBOUND(InData%b2,1) + DbKiBuf(Db_Xferred) = InData%b2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b3,1), UBOUND(InData%b3,1) + DbKiBuf(Db_Xferred) = InData%b3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c1,1), UBOUND(InData%c1,1) + DbKiBuf(Db_Xferred) = InData%c1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c2,1), UBOUND(InData%c2,1) + DbKiBuf(Db_Xferred) = InData%c2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c3,1), UBOUND(InData%c3,1) + DbKiBuf(Db_Xferred) = InData%c3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d1,1), UBOUND(InData%d1,1) + DbKiBuf(Db_Xferred) = InData%d1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d2,1), UBOUND(InData%d2,1) + DbKiBuf(Db_Xferred) = InData%d2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d3,1), UBOUND(InData%d3,1) + DbKiBuf(Db_Xferred) = InData%d3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e1,1), UBOUND(InData%e1,1) + DbKiBuf(Db_Xferred) = InData%e1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e2,1), UBOUND(InData%e2,1) + DbKiBuf(Db_Xferred) = InData%e2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e3,1), UBOUND(InData%e3,1) + DbKiBuf(Db_Xferred) = InData%e3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f1,1), UBOUND(InData%f1,1) + DbKiBuf(Db_Xferred) = InData%f1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f2,1), UBOUND(InData%f2,1) + DbKiBuf(Db_Xferred) = InData%f2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f3,1), UBOUND(InData%f3,1) + DbKiBuf(Db_Xferred) = InData%f3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g1,1), UBOUND(InData%g1,1) + DbKiBuf(Db_Xferred) = InData%g1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g2,1), UBOUND(InData%g2,1) + DbKiBuf(Db_Xferred) = InData%g2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g3,1), UBOUND(InData%g3,1) + DbKiBuf(Db_Xferred) = InData%g3(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%i1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6703,8 +6654,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i1))-1 ) = PACK(InData%i1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i1) + DO i2 = LBOUND(InData%i1,2), UBOUND(InData%i1,2) + DO i1 = LBOUND(InData%i1,1), UBOUND(InData%i1,1) + DbKiBuf(Db_Xferred) = InData%i1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%i2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6719,8 +6674,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i2))-1 ) = PACK(InData%i2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i2) + DO i2 = LBOUND(InData%i2,2), UBOUND(InData%i2,2) + DO i1 = LBOUND(InData%i2,1), UBOUND(InData%i2,1) + DbKiBuf(Db_Xferred) = InData%i2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%i3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6735,8 +6694,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i3))-1 ) = PACK(InData%i3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i3) + DO i2 = LBOUND(InData%i3,2), UBOUND(InData%i3,2) + DO i1 = LBOUND(InData%i3,1), UBOUND(InData%i3,1) + DbKiBuf(Db_Xferred) = InData%i3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6751,8 +6714,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j1))-1 ) = PACK(InData%j1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j1) + DO i2 = LBOUND(InData%j1,2), UBOUND(InData%j1,2) + DO i1 = LBOUND(InData%j1,1), UBOUND(InData%j1,1) + DbKiBuf(Db_Xferred) = InData%j1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6767,8 +6734,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j2))-1 ) = PACK(InData%j2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j2) + DO i2 = LBOUND(InData%j2,2), UBOUND(InData%j2,2) + DO i1 = LBOUND(InData%j2,1), UBOUND(InData%j2,1) + DbKiBuf(Db_Xferred) = InData%j2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6783,8 +6754,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j3))-1 ) = PACK(InData%j3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j3) + DO i2 = LBOUND(InData%j3,2), UBOUND(InData%j3,2) + DO i1 = LBOUND(InData%j3,1), UBOUND(InData%j3,1) + DbKiBuf(Db_Xferred) = InData%j3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6802,8 +6777,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m1))-1 ) = PACK(InData%m1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m1) + DO i3 = LBOUND(InData%m1,3), UBOUND(InData%m1,3) + DO i2 = LBOUND(InData%m1,2), UBOUND(InData%m1,2) + DO i1 = LBOUND(InData%m1,1), UBOUND(InData%m1,1) + DbKiBuf(Db_Xferred) = InData%m1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6821,8 +6802,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m2))-1 ) = PACK(InData%m2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m2) + DO i3 = LBOUND(InData%m2,3), UBOUND(InData%m2,3) + DO i2 = LBOUND(InData%m2,2), UBOUND(InData%m2,2) + DO i1 = LBOUND(InData%m2,1), UBOUND(InData%m2,1) + DbKiBuf(Db_Xferred) = InData%m2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6840,8 +6827,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m3))-1 ) = PACK(InData%m3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m3) + DO i3 = LBOUND(InData%m3,3), UBOUND(InData%m3,3) + DO i2 = LBOUND(InData%m3,2), UBOUND(InData%m3,2) + DO i1 = LBOUND(InData%m3,1), UBOUND(InData%m3,1) + DbKiBuf(Db_Xferred) = InData%m3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6859,8 +6852,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n1))-1 ) = PACK(InData%n1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n1) + DO i3 = LBOUND(InData%n1,3), UBOUND(InData%n1,3) + DO i2 = LBOUND(InData%n1,2), UBOUND(InData%n1,2) + DO i1 = LBOUND(InData%n1,1), UBOUND(InData%n1,1) + DbKiBuf(Db_Xferred) = InData%n1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6878,8 +6877,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n2))-1 ) = PACK(InData%n2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n2) + DO i3 = LBOUND(InData%n2,3), UBOUND(InData%n2,3) + DO i2 = LBOUND(InData%n2,2), UBOUND(InData%n2,2) + DO i1 = LBOUND(InData%n2,1), UBOUND(InData%n2,1) + DbKiBuf(Db_Xferred) = InData%n2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6897,38 +6902,62 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n3))-1 ) = PACK(InData%n3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n3) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p1))-1 ) = PACK(InData%p1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p2))-1 ) = PACK(InData%p2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p3))-1 ) = PACK(InData%p3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf1))-1 ) = PACK(InData%rf1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf2))-1 ) = PACK(InData%rf2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf3))-1 ) = PACK(InData%rf3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rfa))-1 ) = PACK(InData%rfa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rfa) - IF ( .NOT. ALLOCATED(InData%t1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,1) + DO i3 = LBOUND(InData%n3,3), UBOUND(InData%n3,3) + DO i2 = LBOUND(InData%n3,2), UBOUND(InData%n3,2) + DO i1 = LBOUND(InData%n3,1), UBOUND(InData%n3,1) + DbKiBuf(Db_Xferred) = InData%n3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%p1,1), UBOUND(InData%p1,1) + DbKiBuf(Db_Xferred) = InData%p1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%p2,1), UBOUND(InData%p2,1) + DbKiBuf(Db_Xferred) = InData%p2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%p3,1), UBOUND(InData%p3,1) + DbKiBuf(Db_Xferred) = InData%p3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf1,1), UBOUND(InData%rf1,1) + DbKiBuf(Db_Xferred) = InData%rf1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf2,1), UBOUND(InData%rf2,1) + DbKiBuf(Db_Xferred) = InData%rf2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf3,1), UBOUND(InData%rf3,1) + DbKiBuf(Db_Xferred) = InData%rf3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rfa,1), UBOUND(InData%rfa,1) + DbKiBuf(Db_Xferred) = InData%rfa(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%t1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,1) Int_Xferred = Int_Xferred + 2 IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,2) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t1))-1 ) = PACK(InData%t1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t1) + DO i2 = LBOUND(InData%t1,2), UBOUND(InData%t1,2) + DO i1 = LBOUND(InData%t1,1), UBOUND(InData%t1,1) + DbKiBuf(Db_Xferred) = InData%t1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%t2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6943,8 +6972,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t2))-1 ) = PACK(InData%t2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t2) + DO i2 = LBOUND(InData%t2,2), UBOUND(InData%t2,2) + DO i1 = LBOUND(InData%t2,1), UBOUND(InData%t2,1) + DbKiBuf(Db_Xferred) = InData%t2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%t3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6959,8 +6992,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t3))-1 ) = PACK(InData%t3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t3) + DO i2 = LBOUND(InData%t3,2), UBOUND(InData%t3,2) + DO i1 = LBOUND(InData%t3,1), UBOUND(InData%t3,1) + DbKiBuf(Db_Xferred) = InData%t3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6978,8 +7015,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te1))-1 ) = PACK(InData%te1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te1) + DO i3 = LBOUND(InData%te1,3), UBOUND(InData%te1,3) + DO i2 = LBOUND(InData%te1,2), UBOUND(InData%te1,2) + DO i1 = LBOUND(InData%te1,1), UBOUND(InData%te1,1) + DbKiBuf(Db_Xferred) = InData%te1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6997,8 +7040,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te2))-1 ) = PACK(InData%te2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te2) + DO i3 = LBOUND(InData%te2,3), UBOUND(InData%te2,3) + DO i2 = LBOUND(InData%te2,2), UBOUND(InData%te2,2) + DO i1 = LBOUND(InData%te2,1), UBOUND(InData%te2,1) + DbKiBuf(Db_Xferred) = InData%te2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7016,23 +7065,43 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te3))-1 ) = PACK(InData%te3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te3) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf1))-1 ) = PACK(InData%tf1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf2))-1 ) = PACK(InData%tf2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf3))-1 ) = PACK(InData%tf3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tfa))-1 ) = PACK(InData%tfa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tfa) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z1))-1 ) = PACK(InData%z1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z2))-1 ) = PACK(InData%z2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z3))-1 ) = PACK(InData%z3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z3) + DO i3 = LBOUND(InData%te3,3), UBOUND(InData%te3,3) + DO i2 = LBOUND(InData%te3,2), UBOUND(InData%te3,2) + DO i1 = LBOUND(InData%te3,1), UBOUND(InData%te3,1) + DbKiBuf(Db_Xferred) = InData%te3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%tf1,1), UBOUND(InData%tf1,1) + DbKiBuf(Db_Xferred) = InData%tf1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tf2,1), UBOUND(InData%tf2,1) + DbKiBuf(Db_Xferred) = InData%tf2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tf3,1), UBOUND(InData%tf3,1) + DbKiBuf(Db_Xferred) = InData%tf3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tfa,1), UBOUND(InData%tfa,1) + DbKiBuf(Db_Xferred) = InData%tfa(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z1,1), UBOUND(InData%z1,1) + DbKiBuf(Db_Xferred) = InData%z1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z2,1), UBOUND(InData%z2,1) + DbKiBuf(Db_Xferred) = InData%z2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z3,1), UBOUND(InData%z3,1) + DbKiBuf(Db_Xferred) = InData%z3(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE ED_PackCoordSys SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7048,12 +7117,6 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -7072,235 +7135,130 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%a1,1) i1_u = UBOUND(OutData%a1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a1,1), UBOUND(OutData%a1,1) + OutData%a1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%a2,1) i1_u = UBOUND(OutData%a2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a2,1), UBOUND(OutData%a2,1) + OutData%a2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%a3,1) i1_u = UBOUND(OutData%a3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a3,1), UBOUND(OutData%a3,1) + OutData%a3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b1,1) i1_u = UBOUND(OutData%b1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b1,1), UBOUND(OutData%b1,1) + OutData%b1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b2,1) i1_u = UBOUND(OutData%b2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b2,1), UBOUND(OutData%b2,1) + OutData%b2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b3,1) i1_u = UBOUND(OutData%b3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b3,1), UBOUND(OutData%b3,1) + OutData%b3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c1,1) i1_u = UBOUND(OutData%c1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c1,1), UBOUND(OutData%c1,1) + OutData%c1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c2,1) i1_u = UBOUND(OutData%c2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c2,1), UBOUND(OutData%c2,1) + OutData%c2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c3,1) i1_u = UBOUND(OutData%c3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c3,1), UBOUND(OutData%c3,1) + OutData%c3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d1,1) i1_u = UBOUND(OutData%d1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d1,1), UBOUND(OutData%d1,1) + OutData%d1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d2,1) i1_u = UBOUND(OutData%d2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d2,1), UBOUND(OutData%d2,1) + OutData%d2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d3,1) i1_u = UBOUND(OutData%d3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d3,1), UBOUND(OutData%d3,1) + OutData%d3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e1,1) i1_u = UBOUND(OutData%e1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e1,1), UBOUND(OutData%e1,1) + OutData%e1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e2,1) i1_u = UBOUND(OutData%e2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e2,1), UBOUND(OutData%e2,1) + OutData%e2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e3,1) i1_u = UBOUND(OutData%e3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e3,1), UBOUND(OutData%e3,1) + OutData%e3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f1,1) i1_u = UBOUND(OutData%f1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f1,1), UBOUND(OutData%f1,1) + OutData%f1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f2,1) i1_u = UBOUND(OutData%f2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f2,1), UBOUND(OutData%f2,1) + OutData%f2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f3,1) i1_u = UBOUND(OutData%f3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f3,1), UBOUND(OutData%f3,1) + OutData%f3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g1,1) i1_u = UBOUND(OutData%g1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g1,1), UBOUND(OutData%g1,1) + OutData%g1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g2,1) i1_u = UBOUND(OutData%g2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g2,1), UBOUND(OutData%g2,1) + OutData%g2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g3,1) i1_u = UBOUND(OutData%g3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g3,1), UBOUND(OutData%g3,1) + OutData%g3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7317,15 +7275,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i1)>0) OutData%i1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i1,2), UBOUND(OutData%i1,2) + DO i1 = LBOUND(OutData%i1,1), UBOUND(OutData%i1,1) + OutData%i1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7343,15 +7298,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i2)>0) OutData%i2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i2,2), UBOUND(OutData%i2,2) + DO i1 = LBOUND(OutData%i2,1), UBOUND(OutData%i2,1) + OutData%i2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7369,15 +7321,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i3)>0) OutData%i3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i3,2), UBOUND(OutData%i3,2) + DO i1 = LBOUND(OutData%i3,1), UBOUND(OutData%i3,1) + OutData%i3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7395,15 +7344,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j1)>0) OutData%j1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j1,2), UBOUND(OutData%j1,2) + DO i1 = LBOUND(OutData%j1,1), UBOUND(OutData%j1,1) + OutData%j1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7421,15 +7367,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j2)>0) OutData%j2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j2,2), UBOUND(OutData%j2,2) + DO i1 = LBOUND(OutData%j2,1), UBOUND(OutData%j2,1) + OutData%j2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7447,15 +7390,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j3)>0) OutData%j3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j3,2), UBOUND(OutData%j3,2) + DO i1 = LBOUND(OutData%j3,1), UBOUND(OutData%j3,1) + OutData%j3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7476,15 +7416,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m1)>0) OutData%m1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m1,3), UBOUND(OutData%m1,3) + DO i2 = LBOUND(OutData%m1,2), UBOUND(OutData%m1,2) + DO i1 = LBOUND(OutData%m1,1), UBOUND(OutData%m1,1) + OutData%m1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7505,15 +7444,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m2)>0) OutData%m2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m2,3), UBOUND(OutData%m2,3) + DO i2 = LBOUND(OutData%m2,2), UBOUND(OutData%m2,2) + DO i1 = LBOUND(OutData%m2,1), UBOUND(OutData%m2,1) + OutData%m2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7534,15 +7472,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m3)>0) OutData%m3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m3,3), UBOUND(OutData%m3,3) + DO i2 = LBOUND(OutData%m3,2), UBOUND(OutData%m3,2) + DO i1 = LBOUND(OutData%m3,1), UBOUND(OutData%m3,1) + OutData%m3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7563,15 +7500,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n1)>0) OutData%n1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n1,3), UBOUND(OutData%n1,3) + DO i2 = LBOUND(OutData%n1,2), UBOUND(OutData%n1,2) + DO i1 = LBOUND(OutData%n1,1), UBOUND(OutData%n1,1) + OutData%n1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7592,15 +7528,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n2)>0) OutData%n2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n2,3), UBOUND(OutData%n2,3) + DO i2 = LBOUND(OutData%n2,2), UBOUND(OutData%n2,2) + DO i1 = LBOUND(OutData%n2,1), UBOUND(OutData%n2,1) + OutData%n2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7621,93 +7556,57 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n3)>0) OutData%n3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n3,3), UBOUND(OutData%n3,3) + DO i2 = LBOUND(OutData%n3,2), UBOUND(OutData%n3,2) + DO i1 = LBOUND(OutData%n3,1), UBOUND(OutData%n3,1) + OutData%n3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%p1,1) i1_u = UBOUND(OutData%p1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p1,1), UBOUND(OutData%p1,1) + OutData%p1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%p2,1) i1_u = UBOUND(OutData%p2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p2,1), UBOUND(OutData%p2,1) + OutData%p2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%p3,1) i1_u = UBOUND(OutData%p3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p3,1), UBOUND(OutData%p3,1) + OutData%p3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf1,1) i1_u = UBOUND(OutData%rf1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf1,1), UBOUND(OutData%rf1,1) + OutData%rf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf2,1) i1_u = UBOUND(OutData%rf2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf2,1), UBOUND(OutData%rf2,1) + OutData%rf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf3,1) i1_u = UBOUND(OutData%rf3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf3,1), UBOUND(OutData%rf3,1) + OutData%rf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rfa,1) i1_u = UBOUND(OutData%rfa,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rfa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rfa))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rfa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rfa,1), UBOUND(OutData%rfa,1) + OutData%rfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7724,15 +7623,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t1)>0) OutData%t1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t1,2), UBOUND(OutData%t1,2) + DO i1 = LBOUND(OutData%t1,1), UBOUND(OutData%t1,1) + OutData%t1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7750,15 +7646,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t2)>0) OutData%t2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t2,2), UBOUND(OutData%t2,2) + DO i1 = LBOUND(OutData%t2,1), UBOUND(OutData%t2,1) + OutData%t2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7776,15 +7669,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t3)>0) OutData%t3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t3,2), UBOUND(OutData%t3,2) + DO i1 = LBOUND(OutData%t3,1), UBOUND(OutData%t3,1) + OutData%t3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7805,15 +7695,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te1)>0) OutData%te1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te1,3), UBOUND(OutData%te1,3) + DO i2 = LBOUND(OutData%te1,2), UBOUND(OutData%te1,2) + DO i1 = LBOUND(OutData%te1,1), UBOUND(OutData%te1,1) + OutData%te1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7834,15 +7723,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te2)>0) OutData%te2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te2,3), UBOUND(OutData%te2,3) + DO i2 = LBOUND(OutData%te2,2), UBOUND(OutData%te2,2) + DO i1 = LBOUND(OutData%te2,1), UBOUND(OutData%te2,1) + OutData%te2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7863,93 +7751,57 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te3)>0) OutData%te3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te3,3), UBOUND(OutData%te3,3) + DO i2 = LBOUND(OutData%te3,2), UBOUND(OutData%te3,2) + DO i1 = LBOUND(OutData%te3,1), UBOUND(OutData%te3,1) + OutData%te3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%tf1,1) i1_u = UBOUND(OutData%tf1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf1,1), UBOUND(OutData%tf1,1) + OutData%tf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tf2,1) i1_u = UBOUND(OutData%tf2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf2,1), UBOUND(OutData%tf2,1) + OutData%tf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tf3,1) i1_u = UBOUND(OutData%tf3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf3,1), UBOUND(OutData%tf3,1) + OutData%tf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tfa,1) i1_u = UBOUND(OutData%tfa,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tfa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tfa))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tfa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tfa,1), UBOUND(OutData%tfa,1) + OutData%tfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z1,1) i1_u = UBOUND(OutData%z1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z1,1), UBOUND(OutData%z1,1) + OutData%z1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z2,1) i1_u = UBOUND(OutData%z2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z2,1), UBOUND(OutData%z2,1) + OutData%z2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z3,1) i1_u = UBOUND(OutData%z3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z3,1), UBOUND(OutData%z3,1) + OutData%z3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE ED_UnPackCoordSys SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) @@ -8363,18 +8215,18 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NActvDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPCE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPDE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPIE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPTE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPTTE - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NActvDOF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPCE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPDE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPIE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPTE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPTTE + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NPSBE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8385,8 +8237,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSBE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NPSBE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NPSBE))-1 ) = PACK(InData%NPSBE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NPSBE) + DO i1 = LBOUND(InData%NPSBE,1), UBOUND(InData%NPSBE,1) + IntKiBuf(Int_Xferred) = InData%NPSBE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NPSE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8398,13 +8252,15 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NPSE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NPSE))-1 ) = PACK(InData%NPSE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NPSE) + DO i1 = LBOUND(InData%NPSE,1), UBOUND(InData%NPSE,1) + IntKiBuf(Int_Xferred) = InData%NPSE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPUE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPYE - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPUE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPYE + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PCE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8415,8 +8271,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PCE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PCE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PCE))-1 ) = PACK(InData%PCE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PCE) + DO i1 = LBOUND(InData%PCE,1), UBOUND(InData%PCE,1) + IntKiBuf(Int_Xferred) = InData%PCE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PDE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8428,8 +8286,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PDE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PDE))-1 ) = PACK(InData%PDE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PDE) + DO i1 = LBOUND(InData%PDE,1), UBOUND(InData%PDE,1) + IntKiBuf(Int_Xferred) = InData%PDE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PIE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8441,8 +8301,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PIE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PIE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PIE))-1 ) = PACK(InData%PIE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PIE) + DO i1 = LBOUND(InData%PIE,1), UBOUND(InData%PIE,1) + IntKiBuf(Int_Xferred) = InData%PIE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PTE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8454,8 +8316,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PTE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PTE))-1 ) = PACK(InData%PTE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PTE) + DO i1 = LBOUND(InData%PTE,1), UBOUND(InData%PTE,1) + IntKiBuf(Int_Xferred) = InData%PTE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PTTE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8467,8 +8331,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTTE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PTTE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PTTE))-1 ) = PACK(InData%PTTE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PTTE) + DO i1 = LBOUND(InData%PTTE,1), UBOUND(InData%PTTE,1) + IntKiBuf(Int_Xferred) = InData%PTTE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8480,8 +8346,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PS)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PS))-1 ) = PACK(InData%PS,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PS) + DO i1 = LBOUND(InData%PS,1), UBOUND(InData%PS,1) + IntKiBuf(Int_Xferred) = InData%PS(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PSBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8496,8 +8364,12 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PSBE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PSBE))-1 ) = PACK(InData%PSBE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PSBE) + DO i2 = LBOUND(InData%PSBE,2), UBOUND(InData%PSBE,2) + DO i1 = LBOUND(InData%PSBE,1), UBOUND(InData%PSBE,1) + IntKiBuf(Int_Xferred) = InData%PSBE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PSE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8512,8 +8384,12 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PSE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PSE))-1 ) = PACK(InData%PSE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PSE) + DO i2 = LBOUND(InData%PSE,2), UBOUND(InData%PSE,2) + DO i1 = LBOUND(InData%PSE,1), UBOUND(InData%PSE,1) + IntKiBuf(Int_Xferred) = InData%PSE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PUE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8525,8 +8401,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PUE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PUE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PUE))-1 ) = PACK(InData%PUE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PUE) + DO i1 = LBOUND(InData%PUE,1), UBOUND(InData%PUE,1) + IntKiBuf(Int_Xferred) = InData%PUE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PYE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8538,8 +8416,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PYE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PYE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PYE))-1 ) = PACK(InData%PYE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PYE) + DO i1 = LBOUND(InData%PYE,1), UBOUND(InData%PYE,1) + IntKiBuf(Int_Xferred) = InData%PYE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SrtPS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8551,8 +8431,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SrtPS)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SrtPS))-1 ) = PACK(InData%SrtPS,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SrtPS) + DO i1 = LBOUND(InData%SrtPS,1), UBOUND(InData%SrtPS,1) + IntKiBuf(Int_Xferred) = InData%SrtPS(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SrtPSNAUG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8564,8 +8446,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPSNAUG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SrtPSNAUG)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SrtPSNAUG))-1 ) = PACK(InData%SrtPSNAUG,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SrtPSNAUG) + DO i1 = LBOUND(InData%SrtPSNAUG,1), UBOUND(InData%SrtPSNAUG,1) + IntKiBuf(Int_Xferred) = InData%SrtPSNAUG(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Diag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8577,8 +8461,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diag,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Diag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Diag))-1 ) = PACK(InData%Diag,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Diag) + DO i1 = LBOUND(InData%Diag,1), UBOUND(InData%Diag,1) + IntKiBuf(Int_Xferred) = InData%Diag(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackActiveDOFs @@ -8595,12 +8481,6 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8616,18 +8496,18 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NActvDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPCE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPDE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPIE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPTE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPTTE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NActvDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPCE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPDE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPIE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPTE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPTTE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSBE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8641,15 +8521,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NPSBE)>0) OutData%NPSBE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NPSBE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NPSBE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NPSBE,1), UBOUND(OutData%NPSBE,1) + OutData%NPSBE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSE not allocated Int_Xferred = Int_Xferred + 1 @@ -8664,20 +8539,15 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NPSE)>0) OutData%NPSE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NPSE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NPSE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NPSE,1), UBOUND(OutData%NPSE,1) + OutData%NPSE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NPUE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPYE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPUE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPYE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PCE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8691,15 +8561,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PCE)>0) OutData%PCE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PCE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PCE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PCE,1), UBOUND(OutData%PCE,1) + OutData%PCE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDE not allocated Int_Xferred = Int_Xferred + 1 @@ -8714,15 +8579,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PDE)>0) OutData%PDE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PDE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PDE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PDE,1), UBOUND(OutData%PDE,1) + OutData%PDE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PIE not allocated Int_Xferred = Int_Xferred + 1 @@ -8737,15 +8597,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PIE)>0) OutData%PIE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PIE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PIE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PIE,1), UBOUND(OutData%PIE,1) + OutData%PIE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTE not allocated Int_Xferred = Int_Xferred + 1 @@ -8760,15 +8615,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PTE)>0) OutData%PTE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PTE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PTE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PTE,1), UBOUND(OutData%PTE,1) + OutData%PTE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTTE not allocated Int_Xferred = Int_Xferred + 1 @@ -8783,15 +8633,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PTTE)>0) OutData%PTTE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PTTE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PTTE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PTTE,1), UBOUND(OutData%PTTE,1) + OutData%PTTE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PS not allocated Int_Xferred = Int_Xferred + 1 @@ -8806,15 +8651,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PS)>0) OutData%PS = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PS))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PS,1), UBOUND(OutData%PS,1) + OutData%PS(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSBE not allocated Int_Xferred = Int_Xferred + 1 @@ -8832,15 +8672,12 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PSBE)>0) OutData%PSBE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PSBE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PSBE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PSBE,2), UBOUND(OutData%PSBE,2) + DO i1 = LBOUND(OutData%PSBE,1), UBOUND(OutData%PSBE,1) + OutData%PSBE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSE not allocated Int_Xferred = Int_Xferred + 1 @@ -8858,15 +8695,12 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PSE)>0) OutData%PSE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PSE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PSE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PSE,2), UBOUND(OutData%PSE,2) + DO i1 = LBOUND(OutData%PSE,1), UBOUND(OutData%PSE,1) + OutData%PSE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PUE not allocated Int_Xferred = Int_Xferred + 1 @@ -8881,15 +8715,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PUE)>0) OutData%PUE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PUE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PUE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PUE,1), UBOUND(OutData%PUE,1) + OutData%PUE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PYE not allocated Int_Xferred = Int_Xferred + 1 @@ -8904,15 +8733,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PYE)>0) OutData%PYE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PYE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PYE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PYE,1), UBOUND(OutData%PYE,1) + OutData%PYE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPS not allocated Int_Xferred = Int_Xferred + 1 @@ -8927,15 +8751,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SrtPS)>0) OutData%SrtPS = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SrtPS))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SrtPS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SrtPS,1), UBOUND(OutData%SrtPS,1) + OutData%SrtPS(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPSNAUG not allocated Int_Xferred = Int_Xferred + 1 @@ -8950,15 +8769,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SrtPSNAUG)>0) OutData%SrtPSNAUG = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SrtPSNAUG))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SrtPSNAUG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SrtPSNAUG,1), UBOUND(OutData%SrtPSNAUG,1) + OutData%SrtPSNAUG(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diag not allocated Int_Xferred = Int_Xferred + 1 @@ -8973,15 +8787,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Diag)>0) OutData%Diag = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Diag))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Diag) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Diag,1), UBOUND(OutData%Diag,1) + OutData%Diag(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackActiveDOFs @@ -10811,8 +10620,10 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rO))-1 ) = PACK(InData%rO,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rO) + DO i1 = LBOUND(InData%rO,1), UBOUND(InData%rO,1) + DbKiBuf(Db_Xferred) = InData%rO(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rQS) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10829,8 +10640,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rQS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQS))-1 ) = PACK(InData%rQS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQS) + DO i3 = LBOUND(InData%rQS,3), UBOUND(InData%rQS,3) + DO i2 = LBOUND(InData%rQS,2), UBOUND(InData%rQS,2) + DO i1 = LBOUND(InData%rQS,1), UBOUND(InData%rQS,1) + DbKiBuf(Db_Xferred) = InData%rQS(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10848,8 +10665,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rS))-1 ) = PACK(InData%rS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rS) + DO i3 = LBOUND(InData%rS,3), UBOUND(InData%rS,3) + DO i2 = LBOUND(InData%rS,2), UBOUND(InData%rS,2) + DO i1 = LBOUND(InData%rS,1), UBOUND(InData%rS,1) + DbKiBuf(Db_Xferred) = InData%rS(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rS0S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10867,8 +10690,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rS0S)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rS0S))-1 ) = PACK(InData%rS0S,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rS0S) + DO i3 = LBOUND(InData%rS0S,3), UBOUND(InData%rS0S,3) + DO i2 = LBOUND(InData%rS0S,2), UBOUND(InData%rS0S,2) + DO i1 = LBOUND(InData%rS0S,1), UBOUND(InData%rS0S,1) + DbKiBuf(Db_Xferred) = InData%rS0S(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10883,11 +10712,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT))-1 ) = PACK(InData%rT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT) + DO i2 = LBOUND(InData%rT,2), UBOUND(InData%rT,2) + DO i1 = LBOUND(InData%rT,1), UBOUND(InData%rT,1) + DbKiBuf(Db_Xferred) = InData%rT(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT0O))-1 ) = PACK(InData%rT0O,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT0O) + DO i1 = LBOUND(InData%rT0O,1), UBOUND(InData%rT0O,1) + DbKiBuf(Db_Xferred) = InData%rT0O(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rT0T) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10901,13 +10736,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rT0T)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT0T))-1 ) = PACK(InData%rT0T,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT0T) + DO i2 = LBOUND(InData%rT0T,2), UBOUND(InData%rT0T,2) + DO i1 = LBOUND(InData%rT0T,1), UBOUND(InData%rT0T,1) + DbKiBuf(Db_Xferred) = InData%rT0T(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZ))-1 ) = PACK(InData%rZ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZO))-1 ) = PACK(InData%rZO,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZO) + DO i1 = LBOUND(InData%rZ,1), UBOUND(InData%rZ,1) + DbKiBuf(Db_Xferred) = InData%rZ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZO,1), UBOUND(InData%rZO,1) + DbKiBuf(Db_Xferred) = InData%rZO(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rZT) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10921,27 +10764,49 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rZT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZT))-1 ) = PACK(InData%rZT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZT) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPQ))-1 ) = PACK(InData%rPQ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPQ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rP))-1 ) = PACK(InData%rP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rP) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rV))-1 ) = PACK(InData%rV,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rV) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZY))-1 ) = PACK(InData%rZY,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZY) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOU))-1 ) = PACK(InData%rOU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOU) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOV))-1 ) = PACK(InData%rOV,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOV) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVD))-1 ) = PACK(InData%rVD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVD) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOW))-1 ) = PACK(InData%rOW,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOW) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPC))-1 ) = PACK(InData%rPC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPC) + DO i2 = LBOUND(InData%rZT,2), UBOUND(InData%rZT,2) + DO i1 = LBOUND(InData%rZT,1), UBOUND(InData%rZT,1) + DbKiBuf(Db_Xferred) = InData%rZT(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%rPQ,1), UBOUND(InData%rPQ,1) + DbKiBuf(Db_Xferred) = InData%rPQ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rP,1), UBOUND(InData%rP,1) + DbKiBuf(Db_Xferred) = InData%rP(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rV,1), UBOUND(InData%rV,1) + DbKiBuf(Db_Xferred) = InData%rV(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZY,1), UBOUND(InData%rZY,1) + DbKiBuf(Db_Xferred) = InData%rZY(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOU,1), UBOUND(InData%rOU,1) + DbKiBuf(Db_Xferred) = InData%rOU(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOV,1), UBOUND(InData%rOV,1) + DbKiBuf(Db_Xferred) = InData%rOV(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVD,1), UBOUND(InData%rVD,1) + DbKiBuf(Db_Xferred) = InData%rVD(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOW,1), UBOUND(InData%rOW,1) + DbKiBuf(Db_Xferred) = InData%rOW(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rPC,1), UBOUND(InData%rPC,1) + DbKiBuf(Db_Xferred) = InData%rPC(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rPS0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10955,25 +10820,45 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rPS0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPS0))-1 ) = PACK(InData%rPS0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPS0) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQ))-1 ) = PACK(InData%rQ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQC))-1 ) = PACK(InData%rQC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQC) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVIMU))-1 ) = PACK(InData%rVIMU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVIMU) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVP))-1 ) = PACK(InData%rVP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVP) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWI))-1 ) = PACK(InData%rWI,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWI) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWJ))-1 ) = PACK(InData%rWJ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWJ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWK))-1 ) = PACK(InData%rWK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWK) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZT0))-1 ) = PACK(InData%rZT0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZT0) + DO i2 = LBOUND(InData%rPS0,2), UBOUND(InData%rPS0,2) + DO i1 = LBOUND(InData%rPS0,1), UBOUND(InData%rPS0,1) + DbKiBuf(Db_Xferred) = InData%rPS0(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%rQ,1), UBOUND(InData%rQ,1) + DbKiBuf(Db_Xferred) = InData%rQ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rQC,1), UBOUND(InData%rQC,1) + DbKiBuf(Db_Xferred) = InData%rQC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVIMU,1), UBOUND(InData%rVIMU,1) + DbKiBuf(Db_Xferred) = InData%rVIMU(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVP,1), UBOUND(InData%rVP,1) + DbKiBuf(Db_Xferred) = InData%rVP(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWI,1), UBOUND(InData%rWI,1) + DbKiBuf(Db_Xferred) = InData%rWI(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWJ,1), UBOUND(InData%rWJ,1) + DbKiBuf(Db_Xferred) = InData%rWJ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWK,1), UBOUND(InData%rWK,1) + DbKiBuf(Db_Xferred) = InData%rWK(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZT0,1), UBOUND(InData%rZT0,1) + DbKiBuf(Db_Xferred) = InData%rZT0(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AngPosEF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10987,8 +10872,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosEF))-1 ) = PACK(InData%AngPosEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosEF) + DO i2 = LBOUND(InData%AngPosEF,2), UBOUND(InData%AngPosEF,2) + DO i1 = LBOUND(InData%AngPosEF,1), UBOUND(InData%AngPosEF,1) + ReKiBuf(Re_Xferred) = InData%AngPosEF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngPosXF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11003,8 +10892,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosXF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosXF))-1 ) = PACK(InData%AngPosXF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosXF) + DO i2 = LBOUND(InData%AngPosXF,2), UBOUND(InData%AngPosXF,2) + DO i1 = LBOUND(InData%AngPosXF,1), UBOUND(InData%AngPosXF,1) + ReKiBuf(Re_Xferred) = InData%AngPosXF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngPosHM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11022,13 +10915,23 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosHM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosHM))-1 ) = PACK(InData%AngPosHM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosHM) + DO i3 = LBOUND(InData%AngPosHM,3), UBOUND(InData%AngPosHM,3) + DO i2 = LBOUND(InData%AngPosHM,2), UBOUND(InData%AngPosHM,2) + DO i1 = LBOUND(InData%AngPosHM,1), UBOUND(InData%AngPosHM,1) + ReKiBuf(Re_Xferred) = InData%AngPosHM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosXB))-1 ) = PACK(InData%AngPosXB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosXB) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosEX))-1 ) = PACK(InData%AngPosEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosEX) + DO i1 = LBOUND(InData%AngPosXB,1), UBOUND(InData%AngPosXB,1) + ReKiBuf(Re_Xferred) = InData%AngPosXB(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngPosEX,1), UBOUND(InData%AngPosEX,1) + ReKiBuf(Re_Xferred) = InData%AngPosEX(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PAngVelEA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11045,8 +10948,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEA))-1 ) = PACK(InData%PAngVelEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEA) + DO i3 = LBOUND(InData%PAngVelEA,3), UBOUND(InData%PAngVelEA,3) + DO i2 = LBOUND(InData%PAngVelEA,2), UBOUND(InData%PAngVelEA,2) + DO i1 = LBOUND(InData%PAngVelEA,1), UBOUND(InData%PAngVelEA,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11067,8 +10976,16 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEF))-1 ) = PACK(InData%PAngVelEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEF) + DO i4 = LBOUND(InData%PAngVelEF,4), UBOUND(InData%PAngVelEF,4) + DO i3 = LBOUND(InData%PAngVelEF,3), UBOUND(InData%PAngVelEF,3) + DO i2 = LBOUND(InData%PAngVelEF,2), UBOUND(InData%PAngVelEF,2) + DO i1 = LBOUND(InData%PAngVelEF,1), UBOUND(InData%PAngVelEF,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEF(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11086,8 +11003,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEG))-1 ) = PACK(InData%PAngVelEG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEG) + DO i3 = LBOUND(InData%PAngVelEG,3), UBOUND(InData%PAngVelEG,3) + DO i2 = LBOUND(InData%PAngVelEG,2), UBOUND(InData%PAngVelEG,2) + DO i1 = LBOUND(InData%PAngVelEG,1), UBOUND(InData%PAngVelEG,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEG(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEH) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11105,8 +11028,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEH)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEH))-1 ) = PACK(InData%PAngVelEH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEH) + DO i3 = LBOUND(InData%PAngVelEH,3), UBOUND(InData%PAngVelEH,3) + DO i2 = LBOUND(InData%PAngVelEH,2), UBOUND(InData%PAngVelEH,2) + DO i1 = LBOUND(InData%PAngVelEH,1), UBOUND(InData%PAngVelEH,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEH(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11124,8 +11053,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEL))-1 ) = PACK(InData%PAngVelEL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEL) + DO i3 = LBOUND(InData%PAngVelEL,3), UBOUND(InData%PAngVelEL,3) + DO i2 = LBOUND(InData%PAngVelEL,2), UBOUND(InData%PAngVelEL,2) + DO i1 = LBOUND(InData%PAngVelEL,1), UBOUND(InData%PAngVelEL,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11149,8 +11084,18 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEM))-1 ) = PACK(InData%PAngVelEM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEM) + DO i5 = LBOUND(InData%PAngVelEM,5), UBOUND(InData%PAngVelEM,5) + DO i4 = LBOUND(InData%PAngVelEM,4), UBOUND(InData%PAngVelEM,4) + DO i3 = LBOUND(InData%PAngVelEM,3), UBOUND(InData%PAngVelEM,3) + DO i2 = LBOUND(InData%PAngVelEM,2), UBOUND(InData%PAngVelEM,2) + DO i1 = LBOUND(InData%PAngVelEM,1), UBOUND(InData%PAngVelEM,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEM(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngVelEM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11193,11 +11138,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEN))-1 ) = PACK(InData%PAngVelEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEN) + DO i3 = LBOUND(InData%PAngVelEN,3), UBOUND(InData%PAngVelEN,3) + DO i2 = LBOUND(InData%PAngVelEN,2), UBOUND(InData%PAngVelEN,2) + DO i1 = LBOUND(InData%PAngVelEN,1), UBOUND(InData%PAngVelEN,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEN(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEA))-1 ) = PACK(InData%AngVelEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEA) + DO i1 = LBOUND(InData%AngVelEA,1), UBOUND(InData%AngVelEA,1) + ReKiBuf(Re_Xferred) = InData%AngVelEA(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PAngVelEB) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11214,8 +11167,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEB))-1 ) = PACK(InData%PAngVelEB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEB) + DO i3 = LBOUND(InData%PAngVelEB,3), UBOUND(InData%PAngVelEB,3) + DO i2 = LBOUND(InData%PAngVelEB,2), UBOUND(InData%PAngVelEB,2) + DO i1 = LBOUND(InData%PAngVelEB,1), UBOUND(InData%PAngVelEB,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEB(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelER) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11233,8 +11192,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelER)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelER))-1 ) = PACK(InData%PAngVelER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelER) + DO i3 = LBOUND(InData%PAngVelER,3), UBOUND(InData%PAngVelER,3) + DO i2 = LBOUND(InData%PAngVelER,2), UBOUND(InData%PAngVelER,2) + DO i1 = LBOUND(InData%PAngVelER,1), UBOUND(InData%PAngVelER,1) + ReKiBuf(Re_Xferred) = InData%PAngVelER(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11252,31 +11217,57 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEX))-1 ) = PACK(InData%PAngVelEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEX) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEG))-1 ) = PACK(InData%AngVelEG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEG) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEH))-1 ) = PACK(InData%AngVelEH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEH) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEL))-1 ) = PACK(InData%AngVelEL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEL) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEN))-1 ) = PACK(InData%AngVelEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEB))-1 ) = PACK(InData%AngVelEB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEB) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelER))-1 ) = PACK(InData%AngVelER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelER) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEX))-1 ) = PACK(InData%AngVelEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEX) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TeetAngVel - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEBt))-1 ) = PACK(InData%AngAccEBt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEBt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccERt))-1 ) = PACK(InData%AngAccERt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccERt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEXt))-1 ) = PACK(InData%AngAccEXt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEXt) + DO i3 = LBOUND(InData%PAngVelEX,3), UBOUND(InData%PAngVelEX,3) + DO i2 = LBOUND(InData%PAngVelEX,2), UBOUND(InData%PAngVelEX,2) + DO i1 = LBOUND(InData%PAngVelEX,1), UBOUND(InData%PAngVelEX,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEX(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%AngVelEG,1), UBOUND(InData%AngVelEG,1) + ReKiBuf(Re_Xferred) = InData%AngVelEG(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEH,1), UBOUND(InData%AngVelEH,1) + ReKiBuf(Re_Xferred) = InData%AngVelEH(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEL,1), UBOUND(InData%AngVelEL,1) + ReKiBuf(Re_Xferred) = InData%AngVelEL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEN,1), UBOUND(InData%AngVelEN,1) + ReKiBuf(Re_Xferred) = InData%AngVelEN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEB,1), UBOUND(InData%AngVelEB,1) + ReKiBuf(Re_Xferred) = InData%AngVelEB(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelER,1), UBOUND(InData%AngVelER,1) + ReKiBuf(Re_Xferred) = InData%AngVelER(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEX,1), UBOUND(InData%AngVelEX,1) + ReKiBuf(Re_Xferred) = InData%AngVelEX(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%TeetAngVel + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%AngAccEBt,1), UBOUND(InData%AngAccEBt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEBt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccERt,1), UBOUND(InData%AngAccERt,1) + ReKiBuf(Re_Xferred) = InData%AngAccERt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEXt,1), UBOUND(InData%AngAccEXt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEXt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AngAccEFt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11290,8 +11281,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngAccEFt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEFt))-1 ) = PACK(InData%AngAccEFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEFt) + DO i2 = LBOUND(InData%AngAccEFt,2), UBOUND(InData%AngAccEFt,2) + DO i1 = LBOUND(InData%AngAccEFt,1), UBOUND(InData%AngAccEFt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEFt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngVelEF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11306,29 +11301,53 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngVelEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEF))-1 ) = PACK(InData%AngVelEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEF) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEAt))-1 ) = PACK(InData%AngAccEAt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEAt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEGt))-1 ) = PACK(InData%AngAccEGt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEGt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEHt))-1 ) = PACK(InData%AngAccEHt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEHt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccENt))-1 ) = PACK(InData%AngAccENt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccENt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccECt))-1 ) = PACK(InData%LinAccECt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccECt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEDt))-1 ) = PACK(InData%LinAccEDt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEDt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEIt))-1 ) = PACK(InData%LinAccEIt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEIt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEJt))-1 ) = PACK(InData%LinAccEJt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEJt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEUt))-1 ) = PACK(InData%LinAccEUt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEUt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEYt))-1 ) = PACK(InData%LinAccEYt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEYt) + DO i2 = LBOUND(InData%AngVelEF,2), UBOUND(InData%AngVelEF,2) + DO i1 = LBOUND(InData%AngVelEF,1), UBOUND(InData%AngVelEF,1) + ReKiBuf(Re_Xferred) = InData%AngVelEF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%AngAccEAt,1), UBOUND(InData%AngAccEAt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEAt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEGt,1), UBOUND(InData%AngAccEGt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEGt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEHt,1), UBOUND(InData%AngAccEHt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEHt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccENt,1), UBOUND(InData%AngAccENt,1) + ReKiBuf(Re_Xferred) = InData%AngAccENt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccECt,1), UBOUND(InData%LinAccECt,1) + ReKiBuf(Re_Xferred) = InData%LinAccECt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEDt,1), UBOUND(InData%LinAccEDt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEDt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEIt,1), UBOUND(InData%LinAccEIt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEIt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEJt,1), UBOUND(InData%LinAccEJt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEJt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEUt,1), UBOUND(InData%LinAccEUt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEUt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEYt,1), UBOUND(InData%LinAccEYt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEYt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinVelES) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11345,11 +11364,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelES)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelES))-1 ) = PACK(InData%LinVelES,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelES) + DO i3 = LBOUND(InData%LinVelES,3), UBOUND(InData%LinVelES,3) + DO i2 = LBOUND(InData%LinVelES,2), UBOUND(InData%LinVelES,2) + DO i1 = LBOUND(InData%LinVelES,1), UBOUND(InData%LinVelES,1) + ReKiBuf(Re_Xferred) = InData%LinVelES(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEQ))-1 ) = PACK(InData%LinVelEQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEQ) + DO i1 = LBOUND(InData%LinVelEQ,1), UBOUND(InData%LinVelEQ,1) + ReKiBuf(Re_Xferred) = InData%LinVelEQ(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinVelET) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11363,8 +11390,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelET)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelET))-1 ) = PACK(InData%LinVelET,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelET) + DO i2 = LBOUND(InData%LinVelET,2), UBOUND(InData%LinVelET,2) + DO i1 = LBOUND(InData%LinVelET,1), UBOUND(InData%LinVelET,1) + ReKiBuf(Re_Xferred) = InData%LinVelET(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LinVelESm2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11376,8 +11407,10 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelESm2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelESm2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelESm2))-1 ) = PACK(InData%LinVelESm2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelESm2) + DO i1 = LBOUND(InData%LinVelESm2,1), UBOUND(InData%LinVelESm2,1) + ReKiBuf(Re_Xferred) = InData%LinVelESm2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEIMU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11395,8 +11428,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEIMU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEIMU))-1 ) = PACK(InData%PLinVelEIMU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEIMU) + DO i3 = LBOUND(InData%PLinVelEIMU,3), UBOUND(InData%PLinVelEIMU,3) + DO i2 = LBOUND(InData%PLinVelEIMU,2), UBOUND(InData%PLinVelEIMU,2) + DO i1 = LBOUND(InData%PLinVelEIMU,1), UBOUND(InData%PLinVelEIMU,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEIMU(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEO) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11414,8 +11453,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEO)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEO))-1 ) = PACK(InData%PLinVelEO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEO) + DO i3 = LBOUND(InData%PLinVelEO,3), UBOUND(InData%PLinVelEO,3) + DO i2 = LBOUND(InData%PLinVelEO,2), UBOUND(InData%PLinVelEO,2) + DO i1 = LBOUND(InData%PLinVelEO,1), UBOUND(InData%PLinVelEO,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEO(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelES) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11439,8 +11484,18 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelES)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelES))-1 ) = PACK(InData%PLinVelES,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelES) + DO i5 = LBOUND(InData%PLinVelES,5), UBOUND(InData%PLinVelES,5) + DO i4 = LBOUND(InData%PLinVelES,4), UBOUND(InData%PLinVelES,4) + DO i3 = LBOUND(InData%PLinVelES,3), UBOUND(InData%PLinVelES,3) + DO i2 = LBOUND(InData%PLinVelES,2), UBOUND(InData%PLinVelES,2) + DO i1 = LBOUND(InData%PLinVelES,1), UBOUND(InData%PLinVelES,1) + ReKiBuf(Re_Xferred) = InData%PLinVelES(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelET) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11461,8 +11516,16 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelET)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelET))-1 ) = PACK(InData%PLinVelET,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelET) + DO i4 = LBOUND(InData%PLinVelET,4), UBOUND(InData%PLinVelET,4) + DO i3 = LBOUND(InData%PLinVelET,3), UBOUND(InData%PLinVelET,3) + DO i2 = LBOUND(InData%PLinVelET,2), UBOUND(InData%PLinVelET,2) + DO i1 = LBOUND(InData%PLinVelET,1), UBOUND(InData%PLinVelET,1) + ReKiBuf(Re_Xferred) = InData%PLinVelET(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11480,8 +11543,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEZ))-1 ) = PACK(InData%PLinVelEZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEZ) + DO i3 = LBOUND(InData%PLinVelEZ,3), UBOUND(InData%PLinVelEZ,3) + DO i2 = LBOUND(InData%PLinVelEZ,2), UBOUND(InData%PLinVelEZ,2) + DO i1 = LBOUND(InData%PLinVelEZ,1), UBOUND(InData%PLinVelEZ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEZ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11499,8 +11568,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEC))-1 ) = PACK(InData%PLinVelEC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEC) + DO i3 = LBOUND(InData%PLinVelEC,3), UBOUND(InData%PLinVelEC,3) + DO i2 = LBOUND(InData%PLinVelEC,2), UBOUND(InData%PLinVelEC,2) + DO i1 = LBOUND(InData%PLinVelEC,1), UBOUND(InData%PLinVelEC,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelED) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11518,8 +11593,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelED)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelED))-1 ) = PACK(InData%PLinVelED,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelED) + DO i3 = LBOUND(InData%PLinVelED,3), UBOUND(InData%PLinVelED,3) + DO i2 = LBOUND(InData%PLinVelED,2), UBOUND(InData%PLinVelED,2) + DO i1 = LBOUND(InData%PLinVelED,1), UBOUND(InData%PLinVelED,1) + ReKiBuf(Re_Xferred) = InData%PLinVelED(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11537,8 +11618,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEI))-1 ) = PACK(InData%PLinVelEI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEI) + DO i3 = LBOUND(InData%PLinVelEI,3), UBOUND(InData%PLinVelEI,3) + DO i2 = LBOUND(InData%PLinVelEI,2), UBOUND(InData%PLinVelEI,2) + DO i1 = LBOUND(InData%PLinVelEI,1), UBOUND(InData%PLinVelEI,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEI(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11556,8 +11643,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEJ))-1 ) = PACK(InData%PLinVelEJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEJ) + DO i3 = LBOUND(InData%PLinVelEJ,3), UBOUND(InData%PLinVelEJ,3) + DO i2 = LBOUND(InData%PLinVelEJ,2), UBOUND(InData%PLinVelEJ,2) + DO i1 = LBOUND(InData%PLinVelEJ,1), UBOUND(InData%PLinVelEJ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEJ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11575,8 +11668,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEK,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEK)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEK))-1 ) = PACK(InData%PLinVelEK,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEK) + DO i3 = LBOUND(InData%PLinVelEK,3), UBOUND(InData%PLinVelEK,3) + DO i2 = LBOUND(InData%PLinVelEK,2), UBOUND(InData%PLinVelEK,2) + DO i1 = LBOUND(InData%PLinVelEK,1), UBOUND(InData%PLinVelEK,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEK(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11594,8 +11693,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEP))-1 ) = PACK(InData%PLinVelEP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEP) + DO i3 = LBOUND(InData%PLinVelEP,3), UBOUND(InData%PLinVelEP,3) + DO i2 = LBOUND(InData%PLinVelEP,2), UBOUND(InData%PLinVelEP,2) + DO i1 = LBOUND(InData%PLinVelEP,1), UBOUND(InData%PLinVelEP,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11613,8 +11718,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEQ))-1 ) = PACK(InData%PLinVelEQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEQ) + DO i3 = LBOUND(InData%PLinVelEQ,3), UBOUND(InData%PLinVelEQ,3) + DO i2 = LBOUND(InData%PLinVelEQ,2), UBOUND(InData%PLinVelEQ,2) + DO i1 = LBOUND(InData%PLinVelEQ,1), UBOUND(InData%PLinVelEQ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEQ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11632,8 +11743,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEU))-1 ) = PACK(InData%PLinVelEU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEU) + DO i3 = LBOUND(InData%PLinVelEU,3), UBOUND(InData%PLinVelEU,3) + DO i2 = LBOUND(InData%PLinVelEU,2), UBOUND(InData%PLinVelEU,2) + DO i1 = LBOUND(InData%PLinVelEU,1), UBOUND(InData%PLinVelEU,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEU(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11651,8 +11768,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEV))-1 ) = PACK(InData%PLinVelEV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEV) + DO i3 = LBOUND(InData%PLinVelEV,3), UBOUND(InData%PLinVelEV,3) + DO i2 = LBOUND(InData%PLinVelEV,2), UBOUND(InData%PLinVelEV,2) + DO i1 = LBOUND(InData%PLinVelEV,1), UBOUND(InData%PLinVelEV,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEV(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEW) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11670,8 +11793,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEW))-1 ) = PACK(InData%PLinVelEW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEW) + DO i3 = LBOUND(InData%PLinVelEW,3), UBOUND(InData%PLinVelEW,3) + DO i2 = LBOUND(InData%PLinVelEW,2), UBOUND(InData%PLinVelEW,2) + DO i1 = LBOUND(InData%PLinVelEW,1), UBOUND(InData%PLinVelEW,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11689,13 +11818,23 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEY))-1 ) = PACK(InData%PLinVelEY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEY) + DO i3 = LBOUND(InData%PLinVelEY,3), UBOUND(InData%PLinVelEY,3) + DO i2 = LBOUND(InData%PLinVelEY,2), UBOUND(InData%PLinVelEY,2) + DO i1 = LBOUND(InData%PLinVelEY,1), UBOUND(InData%PLinVelEY,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEY(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEIMUt))-1 ) = PACK(InData%LinAccEIMUt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEIMUt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEOt))-1 ) = PACK(InData%LinAccEOt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEOt) + DO i1 = LBOUND(InData%LinAccEIMUt,1), UBOUND(InData%LinAccEIMUt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEIMUt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEOt,1), UBOUND(InData%LinAccEOt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEOt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinAccESt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11712,8 +11851,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinAccESt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccESt))-1 ) = PACK(InData%LinAccESt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccESt) + DO i3 = LBOUND(InData%LinAccESt,3), UBOUND(InData%LinAccESt,3) + DO i2 = LBOUND(InData%LinAccESt,2), UBOUND(InData%LinAccESt,2) + DO i1 = LBOUND(InData%LinAccESt,1), UBOUND(InData%LinAccESt,1) + ReKiBuf(Re_Xferred) = InData%LinAccESt(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LinAccETt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11728,21 +11873,37 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinAccETt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccETt))-1 ) = PACK(InData%LinAccETt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccETt) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEZt))-1 ) = PACK(InData%LinAccEZt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEZt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEIMU))-1 ) = PACK(InData%LinVelEIMU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEIMU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEZ))-1 ) = PACK(InData%LinVelEZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEZ) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEO))-1 ) = PACK(InData%LinVelEO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEO) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcONcRtt))-1 ) = PACK(InData%FrcONcRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcONcRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcPRott))-1 ) = PACK(InData%FrcPRott,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcPRott) + DO i2 = LBOUND(InData%LinAccETt,2), UBOUND(InData%LinAccETt,2) + DO i1 = LBOUND(InData%LinAccETt,1), UBOUND(InData%LinAccETt,1) + ReKiBuf(Re_Xferred) = InData%LinAccETt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%LinAccEZt,1), UBOUND(InData%LinAccEZt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEZt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEIMU,1), UBOUND(InData%LinVelEIMU,1) + ReKiBuf(Re_Xferred) = InData%LinVelEIMU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEZ,1), UBOUND(InData%LinVelEZ,1) + ReKiBuf(Re_Xferred) = InData%LinVelEZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEO,1), UBOUND(InData%LinVelEO,1) + ReKiBuf(Re_Xferred) = InData%LinVelEO(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcONcRtt,1), UBOUND(InData%FrcONcRtt,1) + ReKiBuf(Re_Xferred) = InData%FrcONcRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcPRott,1), UBOUND(InData%FrcPRott,1) + ReKiBuf(Re_Xferred) = InData%FrcPRott(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%FrcS0Bt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11756,11 +11917,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FrcS0Bt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcS0Bt))-1 ) = PACK(InData%FrcS0Bt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcS0Bt) + DO i2 = LBOUND(InData%FrcS0Bt,2), UBOUND(InData%FrcS0Bt,2) + DO i1 = LBOUND(InData%FrcS0Bt,1), UBOUND(InData%FrcS0Bt,1) + ReKiBuf(Re_Xferred) = InData%FrcS0Bt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcT0Trbt))-1 ) = PACK(InData%FrcT0Trbt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcT0Trbt) + DO i1 = LBOUND(InData%FrcT0Trbt,1), UBOUND(InData%FrcT0Trbt,1) + ReKiBuf(Re_Xferred) = InData%FrcT0Trbt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%FSAero) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11777,8 +11944,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSAero)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSAero))-1 ) = PACK(InData%FSAero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSAero) + DO i3 = LBOUND(InData%FSAero,3), UBOUND(InData%FSAero,3) + DO i2 = LBOUND(InData%FSAero,2), UBOUND(InData%FSAero,2) + DO i1 = LBOUND(InData%FSAero,1), UBOUND(InData%FSAero,1) + ReKiBuf(Re_Xferred) = InData%FSAero(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSTipDrag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11793,8 +11966,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSTipDrag)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSTipDrag))-1 ) = PACK(InData%FSTipDrag,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSTipDrag) + DO i2 = LBOUND(InData%FSTipDrag,2), UBOUND(InData%FSTipDrag,2) + DO i1 = LBOUND(InData%FSTipDrag,1), UBOUND(InData%FSTipDrag,1) + ReKiBuf(Re_Xferred) = InData%FSTipDrag(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTHydrot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11809,11 +11986,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTHydrot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTHydrot))-1 ) = PACK(InData%FTHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTHydrot) + DO i2 = LBOUND(InData%FTHydrot,2), UBOUND(InData%FTHydrot,2) + DO i1 = LBOUND(InData%FTHydrot,1), UBOUND(InData%FTHydrot,1) + ReKiBuf(Re_Xferred) = InData%FTHydrot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FZHydrot))-1 ) = PACK(InData%FZHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FZHydrot) + DO i1 = LBOUND(InData%FZHydrot,1), UBOUND(InData%FZHydrot,1) + ReKiBuf(Re_Xferred) = InData%FZHydrot(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MFHydrot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11827,11 +12010,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MFHydrot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MFHydrot))-1 ) = PACK(InData%MFHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MFHydrot) + DO i2 = LBOUND(InData%MFHydrot,2), UBOUND(InData%MFHydrot,2) + DO i1 = LBOUND(InData%MFHydrot,1), UBOUND(InData%MFHydrot,1) + ReKiBuf(Re_Xferred) = InData%MFHydrot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomBNcRtt))-1 ) = PACK(InData%MomBNcRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomBNcRtt) + DO i1 = LBOUND(InData%MomBNcRtt,1), UBOUND(InData%MomBNcRtt,1) + ReKiBuf(Re_Xferred) = InData%MomBNcRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MomH0Bt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11845,17 +12034,29 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MomH0Bt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomH0Bt))-1 ) = PACK(InData%MomH0Bt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomH0Bt) + DO i2 = LBOUND(InData%MomH0Bt,2), UBOUND(InData%MomH0Bt,2) + DO i1 = LBOUND(InData%MomH0Bt,1), UBOUND(InData%MomH0Bt,1) + ReKiBuf(Re_Xferred) = InData%MomH0Bt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomLPRott))-1 ) = PACK(InData%MomLPRott,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomLPRott) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomNGnRtt))-1 ) = PACK(InData%MomNGnRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomNGnRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomNTailt))-1 ) = PACK(InData%MomNTailt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomNTailt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomX0Trbt))-1 ) = PACK(InData%MomX0Trbt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomX0Trbt) + DO i1 = LBOUND(InData%MomLPRott,1), UBOUND(InData%MomLPRott,1) + ReKiBuf(Re_Xferred) = InData%MomLPRott(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomNGnRtt,1), UBOUND(InData%MomNGnRtt,1) + ReKiBuf(Re_Xferred) = InData%MomNGnRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomNTailt,1), UBOUND(InData%MomNTailt,1) + ReKiBuf(Re_Xferred) = InData%MomNTailt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomX0Trbt,1), UBOUND(InData%MomX0Trbt,1) + ReKiBuf(Re_Xferred) = InData%MomX0Trbt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MMAero) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11872,11 +12073,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MMAero)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MMAero))-1 ) = PACK(InData%MMAero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MMAero) + DO i3 = LBOUND(InData%MMAero,3), UBOUND(InData%MMAero,3) + DO i2 = LBOUND(InData%MMAero,2), UBOUND(InData%MMAero,2) + DO i1 = LBOUND(InData%MMAero,1), UBOUND(InData%MMAero,1) + ReKiBuf(Re_Xferred) = InData%MMAero(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MXHydrot))-1 ) = PACK(InData%MXHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MXHydrot) + DO i1 = LBOUND(InData%MXHydrot,1), UBOUND(InData%MXHydrot,1) + ReKiBuf(Re_Xferred) = InData%MXHydrot(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PFrcONcRt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11890,8 +12099,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcONcRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcONcRt))-1 ) = PACK(InData%PFrcONcRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcONcRt) + DO i2 = LBOUND(InData%PFrcONcRt,2), UBOUND(InData%PFrcONcRt,2) + DO i1 = LBOUND(InData%PFrcONcRt,1), UBOUND(InData%PFrcONcRt,1) + ReKiBuf(Re_Xferred) = InData%PFrcONcRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcPRot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11906,8 +12119,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcPRot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcPRot))-1 ) = PACK(InData%PFrcPRot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcPRot) + DO i2 = LBOUND(InData%PFrcPRot,2), UBOUND(InData%PFrcPRot,2) + DO i1 = LBOUND(InData%PFrcPRot,1), UBOUND(InData%PFrcPRot,1) + ReKiBuf(Re_Xferred) = InData%PFrcPRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcS0B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11925,8 +12142,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcS0B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcS0B))-1 ) = PACK(InData%PFrcS0B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcS0B) + DO i3 = LBOUND(InData%PFrcS0B,3), UBOUND(InData%PFrcS0B,3) + DO i2 = LBOUND(InData%PFrcS0B,2), UBOUND(InData%PFrcS0B,2) + DO i1 = LBOUND(InData%PFrcS0B,1), UBOUND(InData%PFrcS0B,1) + ReKiBuf(Re_Xferred) = InData%PFrcS0B(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcT0Trb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11941,8 +12164,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcT0Trb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcT0Trb))-1 ) = PACK(InData%PFrcT0Trb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcT0Trb) + DO i2 = LBOUND(InData%PFrcT0Trb,2), UBOUND(InData%PFrcT0Trb,2) + DO i1 = LBOUND(InData%PFrcT0Trb,1), UBOUND(InData%PFrcT0Trb,1) + ReKiBuf(Re_Xferred) = InData%PFrcT0Trb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFTHydro) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11960,11 +12187,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFTHydro)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFTHydro))-1 ) = PACK(InData%PFTHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFTHydro) + DO i3 = LBOUND(InData%PFTHydro,3), UBOUND(InData%PFTHydro,3) + DO i2 = LBOUND(InData%PFTHydro,2), UBOUND(InData%PFTHydro,2) + DO i1 = LBOUND(InData%PFTHydro,1), UBOUND(InData%PFTHydro,1) + ReKiBuf(Re_Xferred) = InData%PFTHydro(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFZHydro))-1 ) = PACK(InData%PFZHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFZHydro) + DO i2 = LBOUND(InData%PFZHydro,2), UBOUND(InData%PFZHydro,2) + DO i1 = LBOUND(InData%PFZHydro,1), UBOUND(InData%PFZHydro,1) + ReKiBuf(Re_Xferred) = InData%PFZHydro(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%PMFHydro) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11981,8 +12218,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMFHydro)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMFHydro))-1 ) = PACK(InData%PMFHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMFHydro) + DO i3 = LBOUND(InData%PMFHydro,3), UBOUND(InData%PMFHydro,3) + DO i2 = LBOUND(InData%PMFHydro,2), UBOUND(InData%PMFHydro,2) + DO i1 = LBOUND(InData%PMFHydro,1), UBOUND(InData%PMFHydro,1) + ReKiBuf(Re_Xferred) = InData%PMFHydro(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomBNcRt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11997,8 +12240,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomBNcRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomBNcRt))-1 ) = PACK(InData%PMomBNcRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomBNcRt) + DO i2 = LBOUND(InData%PMomBNcRt,2), UBOUND(InData%PMomBNcRt,2) + DO i1 = LBOUND(InData%PMomBNcRt,1), UBOUND(InData%PMomBNcRt,1) + ReKiBuf(Re_Xferred) = InData%PMomBNcRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomH0B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12016,8 +12263,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomH0B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomH0B))-1 ) = PACK(InData%PMomH0B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomH0B) + DO i3 = LBOUND(InData%PMomH0B,3), UBOUND(InData%PMomH0B,3) + DO i2 = LBOUND(InData%PMomH0B,2), UBOUND(InData%PMomH0B,2) + DO i1 = LBOUND(InData%PMomH0B,1), UBOUND(InData%PMomH0B,1) + ReKiBuf(Re_Xferred) = InData%PMomH0B(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomLPRot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12032,8 +12285,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomLPRot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomLPRot))-1 ) = PACK(InData%PMomLPRot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomLPRot) + DO i2 = LBOUND(InData%PMomLPRot,2), UBOUND(InData%PMomLPRot,2) + DO i1 = LBOUND(InData%PMomLPRot,1), UBOUND(InData%PMomLPRot,1) + ReKiBuf(Re_Xferred) = InData%PMomLPRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomNGnRt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12048,8 +12305,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomNGnRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomNGnRt))-1 ) = PACK(InData%PMomNGnRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomNGnRt) + DO i2 = LBOUND(InData%PMomNGnRt,2), UBOUND(InData%PMomNGnRt,2) + DO i1 = LBOUND(InData%PMomNGnRt,1), UBOUND(InData%PMomNGnRt,1) + ReKiBuf(Re_Xferred) = InData%PMomNGnRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomNTail) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12064,8 +12325,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomNTail)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomNTail))-1 ) = PACK(InData%PMomNTail,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomNTail) + DO i2 = LBOUND(InData%PMomNTail,2), UBOUND(InData%PMomNTail,2) + DO i1 = LBOUND(InData%PMomNTail,1), UBOUND(InData%PMomNTail,1) + ReKiBuf(Re_Xferred) = InData%PMomNTail(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomX0Trb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12080,21 +12345,37 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomX0Trb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomX0Trb))-1 ) = PACK(InData%PMomX0Trb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomX0Trb) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMXHydro))-1 ) = PACK(InData%PMXHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMXHydro) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TeetAng - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcVGnRtt))-1 ) = PACK(InData%FrcVGnRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcVGnRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcWTailt))-1 ) = PACK(InData%FrcWTailt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcWTailt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcZAllt))-1 ) = PACK(InData%FrcZAllt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcZAllt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomXAllt))-1 ) = PACK(InData%MomXAllt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomXAllt) + DO i2 = LBOUND(InData%PMomX0Trb,2), UBOUND(InData%PMomX0Trb,2) + DO i1 = LBOUND(InData%PMomX0Trb,1), UBOUND(InData%PMomX0Trb,1) + ReKiBuf(Re_Xferred) = InData%PMomX0Trb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i2 = LBOUND(InData%PMXHydro,2), UBOUND(InData%PMXHydro,2) + DO i1 = LBOUND(InData%PMXHydro,1), UBOUND(InData%PMXHydro,1) + ReKiBuf(Re_Xferred) = InData%PMXHydro(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DbKiBuf(Db_Xferred) = InData%TeetAng + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%FrcVGnRtt,1), UBOUND(InData%FrcVGnRtt,1) + ReKiBuf(Re_Xferred) = InData%FrcVGnRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcWTailt,1), UBOUND(InData%FrcWTailt,1) + ReKiBuf(Re_Xferred) = InData%FrcWTailt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcZAllt,1), UBOUND(InData%FrcZAllt,1) + ReKiBuf(Re_Xferred) = InData%FrcZAllt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomXAllt,1), UBOUND(InData%MomXAllt,1) + ReKiBuf(Re_Xferred) = InData%MomXAllt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PFrcVGnRt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12108,8 +12389,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcVGnRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcVGnRt))-1 ) = PACK(InData%PFrcVGnRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcVGnRt) + DO i2 = LBOUND(InData%PFrcVGnRt,2), UBOUND(InData%PFrcVGnRt,2) + DO i1 = LBOUND(InData%PFrcVGnRt,1), UBOUND(InData%PFrcVGnRt,1) + ReKiBuf(Re_Xferred) = InData%PFrcVGnRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcWTail) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12124,8 +12409,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcWTail)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcWTail))-1 ) = PACK(InData%PFrcWTail,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcWTail) + DO i2 = LBOUND(InData%PFrcWTail,2), UBOUND(InData%PFrcWTail,2) + DO i1 = LBOUND(InData%PFrcWTail,1), UBOUND(InData%PFrcWTail,1) + ReKiBuf(Re_Xferred) = InData%PFrcWTail(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcZAll) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12140,8 +12429,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcZAll)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcZAll))-1 ) = PACK(InData%PFrcZAll,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcZAll) + DO i2 = LBOUND(InData%PFrcZAll,2), UBOUND(InData%PFrcZAll,2) + DO i1 = LBOUND(InData%PFrcZAll,1), UBOUND(InData%PFrcZAll,1) + ReKiBuf(Re_Xferred) = InData%PFrcZAll(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomXAll) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12156,17 +12449,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomXAll)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomXAll))-1 ) = PACK(InData%PMomXAll,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomXAll) + DO i2 = LBOUND(InData%PMomXAll,2), UBOUND(InData%PMomXAll,2) + DO i1 = LBOUND(InData%PMomXAll,1), UBOUND(InData%PMomXAll,1) + ReKiBuf(Re_Xferred) = InData%PMomXAll(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEffFac - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEffFac + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rSAerCen) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12183,8 +12480,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCen))-1 ) = PACK(InData%rSAerCen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCen) + DO i3 = LBOUND(InData%rSAerCen,3), UBOUND(InData%rSAerCen,3) + DO i2 = LBOUND(InData%rSAerCen,2), UBOUND(InData%rSAerCen,2) + DO i1 = LBOUND(InData%rSAerCen,1), UBOUND(InData%rSAerCen,1) + ReKiBuf(Re_Xferred) = InData%rSAerCen(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE ED_PackRtHndSide @@ -12201,12 +12504,6 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -12227,15 +12524,10 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%rO,1) i1_u = UBOUND(OutData%rO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rO = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rO))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rO,1), UBOUND(OutData%rO,1) + OutData%rO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rQS not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12255,15 +12547,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rQS)>0) OutData%rQS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQS))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rQS,3), UBOUND(OutData%rQS,3) + DO i2 = LBOUND(OutData%rQS,2), UBOUND(OutData%rQS,2) + DO i1 = LBOUND(OutData%rQS,1), UBOUND(OutData%rQS,1) + OutData%rQS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS not allocated Int_Xferred = Int_Xferred + 1 @@ -12284,15 +12575,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rS)>0) OutData%rS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rS))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rS,3), UBOUND(OutData%rS,3) + DO i2 = LBOUND(OutData%rS,2), UBOUND(OutData%rS,2) + DO i1 = LBOUND(OutData%rS,1), UBOUND(OutData%rS,1) + OutData%rS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS0S not allocated Int_Xferred = Int_Xferred + 1 @@ -12313,15 +12603,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rS0S)>0) OutData%rS0S = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rS0S))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rS0S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rS0S,3), UBOUND(OutData%rS0S,3) + DO i2 = LBOUND(OutData%rS0S,2), UBOUND(OutData%rS0S,2) + DO i1 = LBOUND(OutData%rS0S,1), UBOUND(OutData%rS0S,1) + OutData%rS0S(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT not allocated Int_Xferred = Int_Xferred + 1 @@ -12339,27 +12628,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rT)>0) OutData%rT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rT,2), UBOUND(OutData%rT,2) + DO i1 = LBOUND(OutData%rT,1), UBOUND(OutData%rT,1) + OutData%rT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rT0O,1) i1_u = UBOUND(OutData%rT0O,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rT0O = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT0O))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT0O) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rT0O,1), UBOUND(OutData%rT0O,1) + OutData%rT0O(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT0T not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12376,38 +12657,25 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rT0T)>0) OutData%rT0T = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT0T))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT0T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rT0T,2), UBOUND(OutData%rT0T,2) + DO i1 = LBOUND(OutData%rT0T,1), UBOUND(OutData%rT0T,1) + OutData%rT0T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rZ,1) i1_u = UBOUND(OutData%rZ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZ,1), UBOUND(OutData%rZ,1) + OutData%rZ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZO,1) i1_u = UBOUND(OutData%rZO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZO = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZO))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZO,1), UBOUND(OutData%rZO,1) + OutData%rZO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rZT not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12424,115 +12692,67 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rZT)>0) OutData%rZT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZT))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rZT,2), UBOUND(OutData%rZT,2) + DO i1 = LBOUND(OutData%rZT,1), UBOUND(OutData%rZT,1) + OutData%rZT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rPQ,1) i1_u = UBOUND(OutData%rPQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rPQ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPQ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rPQ,1), UBOUND(OutData%rPQ,1) + OutData%rPQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rP,1) i1_u = UBOUND(OutData%rP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rP))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rP,1), UBOUND(OutData%rP,1) + OutData%rP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rV,1) i1_u = UBOUND(OutData%rV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rV = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rV))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rV,1), UBOUND(OutData%rV,1) + OutData%rV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZY,1) i1_u = UBOUND(OutData%rZY,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZY = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZY))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZY,1), UBOUND(OutData%rZY,1) + OutData%rZY(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOU,1) i1_u = UBOUND(OutData%rOU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOU,1), UBOUND(OutData%rOU,1) + OutData%rOU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOV,1) i1_u = UBOUND(OutData%rOV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOV = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOV))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOV,1), UBOUND(OutData%rOV,1) + OutData%rOV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVD,1) i1_u = UBOUND(OutData%rVD,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVD))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVD,1), UBOUND(OutData%rVD,1) + OutData%rVD(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOW,1) i1_u = UBOUND(OutData%rOW,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOW = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOW))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOW) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOW,1), UBOUND(OutData%rOW,1) + OutData%rOW(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rPC,1) i1_u = UBOUND(OutData%rPC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rPC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rPC,1), UBOUND(OutData%rPC,1) + OutData%rPC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rPS0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12549,104 +12769,61 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rPS0)>0) OutData%rPS0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPS0))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPS0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rPS0,2), UBOUND(OutData%rPS0,2) + DO i1 = LBOUND(OutData%rPS0,1), UBOUND(OutData%rPS0,1) + OutData%rPS0(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rQ,1) i1_u = UBOUND(OutData%rQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rQ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rQ,1), UBOUND(OutData%rQ,1) + OutData%rQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rQC,1) i1_u = UBOUND(OutData%rQC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rQC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rQC,1), UBOUND(OutData%rQC,1) + OutData%rQC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVIMU,1) i1_u = UBOUND(OutData%rVIMU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVIMU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVIMU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVIMU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVIMU,1), UBOUND(OutData%rVIMU,1) + OutData%rVIMU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVP,1) i1_u = UBOUND(OutData%rVP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVP))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVP,1), UBOUND(OutData%rVP,1) + OutData%rVP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWI,1) i1_u = UBOUND(OutData%rWI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWI = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWI))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWI,1), UBOUND(OutData%rWI,1) + OutData%rWI(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWJ,1) i1_u = UBOUND(OutData%rWJ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWJ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWJ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWJ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWJ,1), UBOUND(OutData%rWJ,1) + OutData%rWJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWK,1) i1_u = UBOUND(OutData%rWK,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWK))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWK) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWK,1), UBOUND(OutData%rWK,1) + OutData%rWK(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZT0,1) i1_u = UBOUND(OutData%rZT0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZT0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZT0))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZT0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZT0,1), UBOUND(OutData%rZT0,1) + OutData%rZT0(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosEF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12663,15 +12840,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngPosEF)>0) OutData%AngPosEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosEF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosEF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngPosEF,2), UBOUND(OutData%AngPosEF,2) + DO i1 = LBOUND(OutData%AngPosEF,1), UBOUND(OutData%AngPosEF,1) + OutData%AngPosEF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosXF not allocated Int_Xferred = Int_Xferred + 1 @@ -12689,15 +12863,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngPosXF)>0) OutData%AngPosXF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosXF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosXF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngPosXF,2), UBOUND(OutData%AngPosXF,2) + DO i1 = LBOUND(OutData%AngPosXF,1), UBOUND(OutData%AngPosXF,1) + OutData%AngPosXF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosHM not allocated Int_Xferred = Int_Xferred + 1 @@ -12718,38 +12889,27 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AngPosHM)>0) OutData%AngPosHM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosHM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosHM) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AngPosHM,3), UBOUND(OutData%AngPosHM,3) + DO i2 = LBOUND(OutData%AngPosHM,2), UBOUND(OutData%AngPosHM,2) + DO i1 = LBOUND(OutData%AngPosHM,1), UBOUND(OutData%AngPosHM,1) + OutData%AngPosHM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngPosXB,1) i1_u = UBOUND(OutData%AngPosXB,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngPosXB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosXB))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosXB) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngPosXB,1), UBOUND(OutData%AngPosXB,1) + OutData%AngPosXB(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngPosEX,1) i1_u = UBOUND(OutData%AngPosEX,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngPosEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosEX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosEX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngPosEX,1), UBOUND(OutData%AngPosEX,1) + OutData%AngPosEX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12769,15 +12929,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEA)>0) OutData%PAngVelEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEA) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEA,3), UBOUND(OutData%PAngVelEA,3) + DO i2 = LBOUND(OutData%PAngVelEA,2), UBOUND(OutData%PAngVelEA,2) + DO i1 = LBOUND(OutData%PAngVelEA,1), UBOUND(OutData%PAngVelEA,1) + OutData%PAngVelEA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEF not allocated Int_Xferred = Int_Xferred + 1 @@ -12801,15 +12960,16 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%PAngVelEF)>0) OutData%PAngVelEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEF))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEF) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%PAngVelEF,4), UBOUND(OutData%PAngVelEF,4) + DO i3 = LBOUND(OutData%PAngVelEF,3), UBOUND(OutData%PAngVelEF,3) + DO i2 = LBOUND(OutData%PAngVelEF,2), UBOUND(OutData%PAngVelEF,2) + DO i1 = LBOUND(OutData%PAngVelEF,1), UBOUND(OutData%PAngVelEF,1) + OutData%PAngVelEF(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEG not allocated Int_Xferred = Int_Xferred + 1 @@ -12830,15 +12990,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEG)>0) OutData%PAngVelEG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEG))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEG) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEG,3), UBOUND(OutData%PAngVelEG,3) + DO i2 = LBOUND(OutData%PAngVelEG,2), UBOUND(OutData%PAngVelEG,2) + DO i1 = LBOUND(OutData%PAngVelEG,1), UBOUND(OutData%PAngVelEG,1) + OutData%PAngVelEG(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEH not allocated Int_Xferred = Int_Xferred + 1 @@ -12859,15 +13018,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEH)>0) OutData%PAngVelEH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEH))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEH) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEH,3), UBOUND(OutData%PAngVelEH,3) + DO i2 = LBOUND(OutData%PAngVelEH,2), UBOUND(OutData%PAngVelEH,2) + DO i1 = LBOUND(OutData%PAngVelEH,1), UBOUND(OutData%PAngVelEH,1) + OutData%PAngVelEH(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEL not allocated Int_Xferred = Int_Xferred + 1 @@ -12888,15 +13046,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEL)>0) OutData%PAngVelEL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEL,3), UBOUND(OutData%PAngVelEL,3) + DO i2 = LBOUND(OutData%PAngVelEL,2), UBOUND(OutData%PAngVelEL,2) + DO i1 = LBOUND(OutData%PAngVelEL,1), UBOUND(OutData%PAngVelEL,1) + OutData%PAngVelEL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEM not allocated Int_Xferred = Int_Xferred + 1 @@ -12923,15 +13080,18 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%PAngVelEM)>0) OutData%PAngVelEM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEM))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEM) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%PAngVelEM,5), UBOUND(OutData%PAngVelEM,5) + DO i4 = LBOUND(OutData%PAngVelEM,4), UBOUND(OutData%PAngVelEM,4) + DO i3 = LBOUND(OutData%PAngVelEM,3), UBOUND(OutData%PAngVelEM,3) + DO i2 = LBOUND(OutData%PAngVelEM,2), UBOUND(OutData%PAngVelEM,2) + DO i1 = LBOUND(OutData%PAngVelEM,1), UBOUND(OutData%PAngVelEM,1) + OutData%PAngVelEM(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEM not allocated Int_Xferred = Int_Xferred + 1 @@ -12980,27 +13140,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEN)>0) OutData%PAngVelEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEN))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEN) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEN,3), UBOUND(OutData%PAngVelEN,3) + DO i2 = LBOUND(OutData%PAngVelEN,2), UBOUND(OutData%PAngVelEN,2) + DO i1 = LBOUND(OutData%PAngVelEN,1), UBOUND(OutData%PAngVelEN,1) + OutData%PAngVelEN(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngVelEA,1) i1_u = UBOUND(OutData%AngVelEA,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEA,1), UBOUND(OutData%AngVelEA,1) + OutData%AngVelEA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEB not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13020,15 +13174,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEB)>0) OutData%PAngVelEB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEB))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEB) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEB,3), UBOUND(OutData%PAngVelEB,3) + DO i2 = LBOUND(OutData%PAngVelEB,2), UBOUND(OutData%PAngVelEB,2) + DO i1 = LBOUND(OutData%PAngVelEB,1), UBOUND(OutData%PAngVelEB,1) + OutData%PAngVelEB(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelER not allocated Int_Xferred = Int_Xferred + 1 @@ -13049,15 +13202,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelER)>0) OutData%PAngVelER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelER))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelER) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelER,3), UBOUND(OutData%PAngVelER,3) + DO i2 = LBOUND(OutData%PAngVelER,2), UBOUND(OutData%PAngVelER,2) + DO i1 = LBOUND(OutData%PAngVelER,1), UBOUND(OutData%PAngVelER,1) + OutData%PAngVelER(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEX not allocated Int_Xferred = Int_Xferred + 1 @@ -13078,128 +13230,77 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEX)>0) OutData%PAngVelEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEX))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEX) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEX,3), UBOUND(OutData%PAngVelEX,3) + DO i2 = LBOUND(OutData%PAngVelEX,2), UBOUND(OutData%PAngVelEX,2) + DO i1 = LBOUND(OutData%PAngVelEX,1), UBOUND(OutData%PAngVelEX,1) + OutData%PAngVelEX(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngVelEG,1) i1_u = UBOUND(OutData%AngVelEG,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEG,1), UBOUND(OutData%AngVelEG,1) + OutData%AngVelEG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEH,1) i1_u = UBOUND(OutData%AngVelEH,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEH))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEH) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEH,1), UBOUND(OutData%AngVelEH,1) + OutData%AngVelEH(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEL,1) i1_u = UBOUND(OutData%AngVelEL,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEL,1), UBOUND(OutData%AngVelEL,1) + OutData%AngVelEL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEN,1) i1_u = UBOUND(OutData%AngVelEN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEN,1), UBOUND(OutData%AngVelEN,1) + OutData%AngVelEN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEB,1) i1_u = UBOUND(OutData%AngVelEB,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEB))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEB) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEB,1), UBOUND(OutData%AngVelEB,1) + OutData%AngVelEB(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelER,1) i1_u = UBOUND(OutData%AngVelER,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelER))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelER) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelER,1), UBOUND(OutData%AngVelER,1) + OutData%AngVelER(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEX,1) i1_u = UBOUND(OutData%AngVelEX,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEX) - DEALLOCATE(mask1) - OutData%TeetAngVel = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%AngVelEX,1), UBOUND(OutData%AngVelEX,1) + OutData%AngVelEX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TeetAngVel = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%AngAccEBt,1) i1_u = UBOUND(OutData%AngAccEBt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEBt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEBt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEBt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEBt,1), UBOUND(OutData%AngAccEBt,1) + OutData%AngAccEBt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccERt,1) i1_u = UBOUND(OutData%AngAccERt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccERt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccERt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccERt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccERt,1), UBOUND(OutData%AngAccERt,1) + OutData%AngAccERt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEXt,1) i1_u = UBOUND(OutData%AngAccEXt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEXt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEXt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEXt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEXt,1), UBOUND(OutData%AngAccEXt,1) + OutData%AngAccEXt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEFt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13216,15 +13317,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngAccEFt)>0) OutData%AngAccEFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEFt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEFt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngAccEFt,2), UBOUND(OutData%AngAccEFt,2) + DO i1 = LBOUND(OutData%AngAccEFt,1), UBOUND(OutData%AngAccEFt,1) + OutData%AngAccEFt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEF not allocated Int_Xferred = Int_Xferred + 1 @@ -13242,126 +13340,73 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngVelEF)>0) OutData%AngVelEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngVelEF,2), UBOUND(OutData%AngVelEF,2) + DO i1 = LBOUND(OutData%AngVelEF,1), UBOUND(OutData%AngVelEF,1) + OutData%AngVelEF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%AngAccEAt,1) i1_u = UBOUND(OutData%AngAccEAt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEAt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEAt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEAt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEAt,1), UBOUND(OutData%AngAccEAt,1) + OutData%AngAccEAt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEGt,1) i1_u = UBOUND(OutData%AngAccEGt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEGt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEGt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEGt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEGt,1), UBOUND(OutData%AngAccEGt,1) + OutData%AngAccEGt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEHt,1) i1_u = UBOUND(OutData%AngAccEHt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEHt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEHt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEHt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEHt,1), UBOUND(OutData%AngAccEHt,1) + OutData%AngAccEHt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccENt,1) i1_u = UBOUND(OutData%AngAccENt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccENt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccENt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccENt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccENt,1), UBOUND(OutData%AngAccENt,1) + OutData%AngAccENt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccECt,1) i1_u = UBOUND(OutData%LinAccECt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccECt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccECt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccECt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccECt,1), UBOUND(OutData%LinAccECt,1) + OutData%LinAccECt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEDt,1) i1_u = UBOUND(OutData%LinAccEDt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEDt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEDt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEDt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEDt,1), UBOUND(OutData%LinAccEDt,1) + OutData%LinAccEDt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEIt,1) i1_u = UBOUND(OutData%LinAccEIt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEIt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEIt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEIt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEIt,1), UBOUND(OutData%LinAccEIt,1) + OutData%LinAccEIt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEJt,1) i1_u = UBOUND(OutData%LinAccEJt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEJt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEJt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEJt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEJt,1), UBOUND(OutData%LinAccEJt,1) + OutData%LinAccEJt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEUt,1) i1_u = UBOUND(OutData%LinAccEUt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEUt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEUt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEUt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEUt,1), UBOUND(OutData%LinAccEUt,1) + OutData%LinAccEUt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEYt,1) i1_u = UBOUND(OutData%LinAccEYt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEYt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEYt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEYt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEYt,1), UBOUND(OutData%LinAccEYt,1) + OutData%LinAccEYt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelES not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13381,27 +13426,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%LinVelES)>0) OutData%LinVelES = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelES))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelES) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%LinVelES,3), UBOUND(OutData%LinVelES,3) + DO i2 = LBOUND(OutData%LinVelES,2), UBOUND(OutData%LinVelES,2) + DO i1 = LBOUND(OutData%LinVelES,1), UBOUND(OutData%LinVelES,1) + OutData%LinVelES(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%LinVelEQ,1) i1_u = UBOUND(OutData%LinVelEQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEQ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEQ,1), UBOUND(OutData%LinVelEQ,1) + OutData%LinVelEQ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelET not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13418,15 +13457,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LinVelET)>0) OutData%LinVelET = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelET))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelET) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LinVelET,2), UBOUND(OutData%LinVelET,2) + DO i1 = LBOUND(OutData%LinVelET,1), UBOUND(OutData%LinVelET,1) + OutData%LinVelET(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelESm2 not allocated Int_Xferred = Int_Xferred + 1 @@ -13441,15 +13477,10 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LinVelESm2)>0) OutData%LinVelESm2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelESm2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelESm2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelESm2,1), UBOUND(OutData%LinVelESm2,1) + OutData%LinVelESm2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEIMU not allocated Int_Xferred = Int_Xferred + 1 @@ -13470,15 +13501,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEIMU)>0) OutData%PLinVelEIMU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEIMU))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEIMU) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEIMU,3), UBOUND(OutData%PLinVelEIMU,3) + DO i2 = LBOUND(OutData%PLinVelEIMU,2), UBOUND(OutData%PLinVelEIMU,2) + DO i1 = LBOUND(OutData%PLinVelEIMU,1), UBOUND(OutData%PLinVelEIMU,1) + OutData%PLinVelEIMU(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEO not allocated Int_Xferred = Int_Xferred + 1 @@ -13499,15 +13529,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEO)>0) OutData%PLinVelEO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEO))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEO) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEO,3), UBOUND(OutData%PLinVelEO,3) + DO i2 = LBOUND(OutData%PLinVelEO,2), UBOUND(OutData%PLinVelEO,2) + DO i1 = LBOUND(OutData%PLinVelEO,1), UBOUND(OutData%PLinVelEO,1) + OutData%PLinVelEO(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelES not allocated Int_Xferred = Int_Xferred + 1 @@ -13534,15 +13563,18 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%PLinVelES)>0) OutData%PLinVelES = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelES))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelES) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%PLinVelES,5), UBOUND(OutData%PLinVelES,5) + DO i4 = LBOUND(OutData%PLinVelES,4), UBOUND(OutData%PLinVelES,4) + DO i3 = LBOUND(OutData%PLinVelES,3), UBOUND(OutData%PLinVelES,3) + DO i2 = LBOUND(OutData%PLinVelES,2), UBOUND(OutData%PLinVelES,2) + DO i1 = LBOUND(OutData%PLinVelES,1), UBOUND(OutData%PLinVelES,1) + OutData%PLinVelES(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelET not allocated Int_Xferred = Int_Xferred + 1 @@ -13566,15 +13598,16 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%PLinVelET)>0) OutData%PLinVelET = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelET))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelET) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%PLinVelET,4), UBOUND(OutData%PLinVelET,4) + DO i3 = LBOUND(OutData%PLinVelET,3), UBOUND(OutData%PLinVelET,3) + DO i2 = LBOUND(OutData%PLinVelET,2), UBOUND(OutData%PLinVelET,2) + DO i1 = LBOUND(OutData%PLinVelET,1), UBOUND(OutData%PLinVelET,1) + OutData%PLinVelET(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEZ not allocated Int_Xferred = Int_Xferred + 1 @@ -13595,15 +13628,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEZ)>0) OutData%PLinVelEZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEZ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEZ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEZ,3), UBOUND(OutData%PLinVelEZ,3) + DO i2 = LBOUND(OutData%PLinVelEZ,2), UBOUND(OutData%PLinVelEZ,2) + DO i1 = LBOUND(OutData%PLinVelEZ,1), UBOUND(OutData%PLinVelEZ,1) + OutData%PLinVelEZ(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEC not allocated Int_Xferred = Int_Xferred + 1 @@ -13624,15 +13656,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEC)>0) OutData%PLinVelEC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEC))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEC) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEC,3), UBOUND(OutData%PLinVelEC,3) + DO i2 = LBOUND(OutData%PLinVelEC,2), UBOUND(OutData%PLinVelEC,2) + DO i1 = LBOUND(OutData%PLinVelEC,1), UBOUND(OutData%PLinVelEC,1) + OutData%PLinVelEC(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelED not allocated Int_Xferred = Int_Xferred + 1 @@ -13653,15 +13684,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelED)>0) OutData%PLinVelED = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelED))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelED) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelED,3), UBOUND(OutData%PLinVelED,3) + DO i2 = LBOUND(OutData%PLinVelED,2), UBOUND(OutData%PLinVelED,2) + DO i1 = LBOUND(OutData%PLinVelED,1), UBOUND(OutData%PLinVelED,1) + OutData%PLinVelED(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEI not allocated Int_Xferred = Int_Xferred + 1 @@ -13682,15 +13712,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEI)>0) OutData%PLinVelEI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEI))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEI) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEI,3), UBOUND(OutData%PLinVelEI,3) + DO i2 = LBOUND(OutData%PLinVelEI,2), UBOUND(OutData%PLinVelEI,2) + DO i1 = LBOUND(OutData%PLinVelEI,1), UBOUND(OutData%PLinVelEI,1) + OutData%PLinVelEI(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEJ not allocated Int_Xferred = Int_Xferred + 1 @@ -13711,15 +13740,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEJ)>0) OutData%PLinVelEJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEJ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEJ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEJ,3), UBOUND(OutData%PLinVelEJ,3) + DO i2 = LBOUND(OutData%PLinVelEJ,2), UBOUND(OutData%PLinVelEJ,2) + DO i1 = LBOUND(OutData%PLinVelEJ,1), UBOUND(OutData%PLinVelEJ,1) + OutData%PLinVelEJ(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEK not allocated Int_Xferred = Int_Xferred + 1 @@ -13740,15 +13768,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEK)>0) OutData%PLinVelEK = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEK))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEK) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEK,3), UBOUND(OutData%PLinVelEK,3) + DO i2 = LBOUND(OutData%PLinVelEK,2), UBOUND(OutData%PLinVelEK,2) + DO i1 = LBOUND(OutData%PLinVelEK,1), UBOUND(OutData%PLinVelEK,1) + OutData%PLinVelEK(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEP not allocated Int_Xferred = Int_Xferred + 1 @@ -13769,15 +13796,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEP)>0) OutData%PLinVelEP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEP,3), UBOUND(OutData%PLinVelEP,3) + DO i2 = LBOUND(OutData%PLinVelEP,2), UBOUND(OutData%PLinVelEP,2) + DO i1 = LBOUND(OutData%PLinVelEP,1), UBOUND(OutData%PLinVelEP,1) + OutData%PLinVelEP(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEQ not allocated Int_Xferred = Int_Xferred + 1 @@ -13798,15 +13824,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEQ)>0) OutData%PLinVelEQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEQ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEQ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEQ,3), UBOUND(OutData%PLinVelEQ,3) + DO i2 = LBOUND(OutData%PLinVelEQ,2), UBOUND(OutData%PLinVelEQ,2) + DO i1 = LBOUND(OutData%PLinVelEQ,1), UBOUND(OutData%PLinVelEQ,1) + OutData%PLinVelEQ(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEU not allocated Int_Xferred = Int_Xferred + 1 @@ -13827,15 +13852,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEU)>0) OutData%PLinVelEU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEU))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEU) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEU,3), UBOUND(OutData%PLinVelEU,3) + DO i2 = LBOUND(OutData%PLinVelEU,2), UBOUND(OutData%PLinVelEU,2) + DO i1 = LBOUND(OutData%PLinVelEU,1), UBOUND(OutData%PLinVelEU,1) + OutData%PLinVelEU(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEV not allocated Int_Xferred = Int_Xferred + 1 @@ -13856,15 +13880,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEV)>0) OutData%PLinVelEV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEV))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEV) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEV,3), UBOUND(OutData%PLinVelEV,3) + DO i2 = LBOUND(OutData%PLinVelEV,2), UBOUND(OutData%PLinVelEV,2) + DO i1 = LBOUND(OutData%PLinVelEV,1), UBOUND(OutData%PLinVelEV,1) + OutData%PLinVelEV(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEW not allocated Int_Xferred = Int_Xferred + 1 @@ -13885,15 +13908,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEW)>0) OutData%PLinVelEW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEW))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEW) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEW,3), UBOUND(OutData%PLinVelEW,3) + DO i2 = LBOUND(OutData%PLinVelEW,2), UBOUND(OutData%PLinVelEW,2) + DO i1 = LBOUND(OutData%PLinVelEW,1), UBOUND(OutData%PLinVelEW,1) + OutData%PLinVelEW(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEY not allocated Int_Xferred = Int_Xferred + 1 @@ -13914,38 +13936,27 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEY)>0) OutData%PLinVelEY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEY))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEY) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEY,3), UBOUND(OutData%PLinVelEY,3) + DO i2 = LBOUND(OutData%PLinVelEY,2), UBOUND(OutData%PLinVelEY,2) + DO i1 = LBOUND(OutData%PLinVelEY,1), UBOUND(OutData%PLinVelEY,1) + OutData%PLinVelEY(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%LinAccEIMUt,1) i1_u = UBOUND(OutData%LinAccEIMUt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEIMUt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEIMUt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEIMUt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEIMUt,1), UBOUND(OutData%LinAccEIMUt,1) + OutData%LinAccEIMUt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEOt,1) i1_u = UBOUND(OutData%LinAccEOt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEOt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEOt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEOt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEOt,1), UBOUND(OutData%LinAccEOt,1) + OutData%LinAccEOt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccESt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13965,15 +13976,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%LinAccESt)>0) OutData%LinAccESt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccESt))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccESt) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%LinAccESt,3), UBOUND(OutData%LinAccESt,3) + DO i2 = LBOUND(OutData%LinAccESt,2), UBOUND(OutData%LinAccESt,2) + DO i1 = LBOUND(OutData%LinAccESt,1), UBOUND(OutData%LinAccESt,1) + OutData%LinAccESt(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccETt not allocated Int_Xferred = Int_Xferred + 1 @@ -13991,82 +14001,49 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LinAccETt)>0) OutData%LinAccETt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccETt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccETt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LinAccETt,2), UBOUND(OutData%LinAccETt,2) + DO i1 = LBOUND(OutData%LinAccETt,1), UBOUND(OutData%LinAccETt,1) + OutData%LinAccETt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%LinAccEZt,1) i1_u = UBOUND(OutData%LinAccEZt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEZt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEZt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEZt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEZt,1), UBOUND(OutData%LinAccEZt,1) + OutData%LinAccEZt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEIMU,1) i1_u = UBOUND(OutData%LinVelEIMU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEIMU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEIMU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEIMU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEIMU,1), UBOUND(OutData%LinVelEIMU,1) + OutData%LinVelEIMU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEZ,1) i1_u = UBOUND(OutData%LinVelEZ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEZ,1), UBOUND(OutData%LinVelEZ,1) + OutData%LinVelEZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEO,1) i1_u = UBOUND(OutData%LinVelEO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEO))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEO,1), UBOUND(OutData%LinVelEO,1) + OutData%LinVelEO(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcONcRtt,1) i1_u = UBOUND(OutData%FrcONcRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcONcRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcONcRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcONcRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcONcRtt,1), UBOUND(OutData%FrcONcRtt,1) + OutData%FrcONcRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcPRott,1) i1_u = UBOUND(OutData%FrcPRott,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcPRott = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcPRott))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcPRott) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcPRott,1), UBOUND(OutData%FrcPRott,1) + OutData%FrcPRott(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FrcS0Bt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14083,27 +14060,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FrcS0Bt)>0) OutData%FrcS0Bt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcS0Bt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcS0Bt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FrcS0Bt,2), UBOUND(OutData%FrcS0Bt,2) + DO i1 = LBOUND(OutData%FrcS0Bt,1), UBOUND(OutData%FrcS0Bt,1) + OutData%FrcS0Bt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FrcT0Trbt,1) i1_u = UBOUND(OutData%FrcT0Trbt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcT0Trbt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcT0Trbt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcT0Trbt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcT0Trbt,1), UBOUND(OutData%FrcT0Trbt,1) + OutData%FrcT0Trbt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSAero not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14123,15 +14092,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FSAero)>0) OutData%FSAero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSAero))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSAero) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FSAero,3), UBOUND(OutData%FSAero,3) + DO i2 = LBOUND(OutData%FSAero,2), UBOUND(OutData%FSAero,2) + DO i1 = LBOUND(OutData%FSAero,1), UBOUND(OutData%FSAero,1) + OutData%FSAero(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSTipDrag not allocated Int_Xferred = Int_Xferred + 1 @@ -14149,15 +14117,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSTipDrag)>0) OutData%FSTipDrag = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSTipDrag))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSTipDrag) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSTipDrag,2), UBOUND(OutData%FSTipDrag,2) + DO i1 = LBOUND(OutData%FSTipDrag,1), UBOUND(OutData%FSTipDrag,1) + OutData%FSTipDrag(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTHydrot not allocated Int_Xferred = Int_Xferred + 1 @@ -14175,27 +14140,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FTHydrot)>0) OutData%FTHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTHydrot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTHydrot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FTHydrot,2), UBOUND(OutData%FTHydrot,2) + DO i1 = LBOUND(OutData%FTHydrot,1), UBOUND(OutData%FTHydrot,1) + OutData%FTHydrot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FZHydrot,1) i1_u = UBOUND(OutData%FZHydrot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FZHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FZHydrot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FZHydrot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FZHydrot,1), UBOUND(OutData%FZHydrot,1) + OutData%FZHydrot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MFHydrot not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14212,27 +14169,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MFHydrot)>0) OutData%MFHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MFHydrot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MFHydrot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MFHydrot,2), UBOUND(OutData%MFHydrot,2) + DO i1 = LBOUND(OutData%MFHydrot,1), UBOUND(OutData%MFHydrot,1) + OutData%MFHydrot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MomBNcRtt,1) i1_u = UBOUND(OutData%MomBNcRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomBNcRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomBNcRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomBNcRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomBNcRtt,1), UBOUND(OutData%MomBNcRtt,1) + OutData%MomBNcRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MomH0Bt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14249,60 +14198,37 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MomH0Bt)>0) OutData%MomH0Bt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomH0Bt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomH0Bt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MomH0Bt,2), UBOUND(OutData%MomH0Bt,2) + DO i1 = LBOUND(OutData%MomH0Bt,1), UBOUND(OutData%MomH0Bt,1) + OutData%MomH0Bt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MomLPRott,1) i1_u = UBOUND(OutData%MomLPRott,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomLPRott = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomLPRott))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomLPRott) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomLPRott,1), UBOUND(OutData%MomLPRott,1) + OutData%MomLPRott(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomNGnRtt,1) i1_u = UBOUND(OutData%MomNGnRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomNGnRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomNGnRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomNGnRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomNGnRtt,1), UBOUND(OutData%MomNGnRtt,1) + OutData%MomNGnRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomNTailt,1) i1_u = UBOUND(OutData%MomNTailt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomNTailt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomNTailt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomNTailt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomNTailt,1), UBOUND(OutData%MomNTailt,1) + OutData%MomNTailt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomX0Trbt,1) i1_u = UBOUND(OutData%MomX0Trbt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomX0Trbt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomX0Trbt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomX0Trbt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomX0Trbt,1), UBOUND(OutData%MomX0Trbt,1) + OutData%MomX0Trbt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMAero not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14322,27 +14248,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%MMAero)>0) OutData%MMAero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MMAero))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MMAero) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%MMAero,3), UBOUND(OutData%MMAero,3) + DO i2 = LBOUND(OutData%MMAero,2), UBOUND(OutData%MMAero,2) + DO i1 = LBOUND(OutData%MMAero,1), UBOUND(OutData%MMAero,1) + OutData%MMAero(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%MXHydrot,1) i1_u = UBOUND(OutData%MXHydrot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MXHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MXHydrot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MXHydrot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MXHydrot,1), UBOUND(OutData%MXHydrot,1) + OutData%MXHydrot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcONcRt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14359,15 +14279,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcONcRt)>0) OutData%PFrcONcRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcONcRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcONcRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcONcRt,2), UBOUND(OutData%PFrcONcRt,2) + DO i1 = LBOUND(OutData%PFrcONcRt,1), UBOUND(OutData%PFrcONcRt,1) + OutData%PFrcONcRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcPRot not allocated Int_Xferred = Int_Xferred + 1 @@ -14385,15 +14302,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcPRot)>0) OutData%PFrcPRot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcPRot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcPRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcPRot,2), UBOUND(OutData%PFrcPRot,2) + DO i1 = LBOUND(OutData%PFrcPRot,1), UBOUND(OutData%PFrcPRot,1) + OutData%PFrcPRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcS0B not allocated Int_Xferred = Int_Xferred + 1 @@ -14414,15 +14328,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PFrcS0B)>0) OutData%PFrcS0B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcS0B))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcS0B) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PFrcS0B,3), UBOUND(OutData%PFrcS0B,3) + DO i2 = LBOUND(OutData%PFrcS0B,2), UBOUND(OutData%PFrcS0B,2) + DO i1 = LBOUND(OutData%PFrcS0B,1), UBOUND(OutData%PFrcS0B,1) + OutData%PFrcS0B(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcT0Trb not allocated Int_Xferred = Int_Xferred + 1 @@ -14440,15 +14353,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcT0Trb)>0) OutData%PFrcT0Trb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcT0Trb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcT0Trb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcT0Trb,2), UBOUND(OutData%PFrcT0Trb,2) + DO i1 = LBOUND(OutData%PFrcT0Trb,1), UBOUND(OutData%PFrcT0Trb,1) + OutData%PFrcT0Trb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFTHydro not allocated Int_Xferred = Int_Xferred + 1 @@ -14469,29 +14379,25 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PFTHydro)>0) OutData%PFTHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFTHydro))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFTHydro) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PFTHydro,3), UBOUND(OutData%PFTHydro,3) + DO i2 = LBOUND(OutData%PFTHydro,2), UBOUND(OutData%PFTHydro,2) + DO i1 = LBOUND(OutData%PFTHydro,1), UBOUND(OutData%PFTHydro,1) + OutData%PFTHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%PFZHydro,1) i1_u = UBOUND(OutData%PFZHydro,1) i2_l = LBOUND(OutData%PFZHydro,2) i2_u = UBOUND(OutData%PFZHydro,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PFZHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFZHydro))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFZHydro) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFZHydro,2), UBOUND(OutData%PFZHydro,2) + DO i1 = LBOUND(OutData%PFZHydro,1), UBOUND(OutData%PFZHydro,1) + OutData%PFZHydro(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMFHydro not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14511,15 +14417,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PMFHydro)>0) OutData%PMFHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMFHydro))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMFHydro) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PMFHydro,3), UBOUND(OutData%PMFHydro,3) + DO i2 = LBOUND(OutData%PMFHydro,2), UBOUND(OutData%PMFHydro,2) + DO i1 = LBOUND(OutData%PMFHydro,1), UBOUND(OutData%PMFHydro,1) + OutData%PMFHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomBNcRt not allocated Int_Xferred = Int_Xferred + 1 @@ -14537,15 +14442,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomBNcRt)>0) OutData%PMomBNcRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomBNcRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomBNcRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomBNcRt,2), UBOUND(OutData%PMomBNcRt,2) + DO i1 = LBOUND(OutData%PMomBNcRt,1), UBOUND(OutData%PMomBNcRt,1) + OutData%PMomBNcRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomH0B not allocated Int_Xferred = Int_Xferred + 1 @@ -14566,15 +14468,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PMomH0B)>0) OutData%PMomH0B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomH0B))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomH0B) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PMomH0B,3), UBOUND(OutData%PMomH0B,3) + DO i2 = LBOUND(OutData%PMomH0B,2), UBOUND(OutData%PMomH0B,2) + DO i1 = LBOUND(OutData%PMomH0B,1), UBOUND(OutData%PMomH0B,1) + OutData%PMomH0B(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomLPRot not allocated Int_Xferred = Int_Xferred + 1 @@ -14592,15 +14493,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomLPRot)>0) OutData%PMomLPRot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomLPRot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomLPRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomLPRot,2), UBOUND(OutData%PMomLPRot,2) + DO i1 = LBOUND(OutData%PMomLPRot,1), UBOUND(OutData%PMomLPRot,1) + OutData%PMomLPRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNGnRt not allocated Int_Xferred = Int_Xferred + 1 @@ -14618,15 +14516,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomNGnRt)>0) OutData%PMomNGnRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomNGnRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomNGnRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomNGnRt,2), UBOUND(OutData%PMomNGnRt,2) + DO i1 = LBOUND(OutData%PMomNGnRt,1), UBOUND(OutData%PMomNGnRt,1) + OutData%PMomNGnRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNTail not allocated Int_Xferred = Int_Xferred + 1 @@ -14644,15 +14539,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomNTail)>0) OutData%PMomNTail = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomNTail))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomNTail) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomNTail,2), UBOUND(OutData%PMomNTail,2) + DO i1 = LBOUND(OutData%PMomNTail,1), UBOUND(OutData%PMomNTail,1) + OutData%PMomNTail(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomX0Trb not allocated Int_Xferred = Int_Xferred + 1 @@ -14670,75 +14562,49 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomX0Trb)>0) OutData%PMomX0Trb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomX0Trb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomX0Trb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomX0Trb,2), UBOUND(OutData%PMomX0Trb,2) + DO i1 = LBOUND(OutData%PMomX0Trb,1), UBOUND(OutData%PMomX0Trb,1) + OutData%PMomX0Trb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%PMXHydro,1) i1_u = UBOUND(OutData%PMXHydro,1) i2_l = LBOUND(OutData%PMXHydro,2) i2_u = UBOUND(OutData%PMXHydro,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PMXHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMXHydro))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMXHydro) - DEALLOCATE(mask2) - OutData%TeetAng = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%PMXHydro,2), UBOUND(OutData%PMXHydro,2) + DO i1 = LBOUND(OutData%PMXHydro,1), UBOUND(OutData%PMXHydro,1) + OutData%PMXHydro(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%TeetAng = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%FrcVGnRtt,1) i1_u = UBOUND(OutData%FrcVGnRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcVGnRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcVGnRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcVGnRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcVGnRtt,1), UBOUND(OutData%FrcVGnRtt,1) + OutData%FrcVGnRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcWTailt,1) i1_u = UBOUND(OutData%FrcWTailt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcWTailt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcWTailt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcWTailt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcWTailt,1), UBOUND(OutData%FrcWTailt,1) + OutData%FrcWTailt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcZAllt,1) i1_u = UBOUND(OutData%FrcZAllt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcZAllt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcZAllt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcZAllt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcZAllt,1), UBOUND(OutData%FrcZAllt,1) + OutData%FrcZAllt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomXAllt,1) i1_u = UBOUND(OutData%MomXAllt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomXAllt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomXAllt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomXAllt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomXAllt,1), UBOUND(OutData%MomXAllt,1) + OutData%MomXAllt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcVGnRt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14755,15 +14621,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcVGnRt)>0) OutData%PFrcVGnRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcVGnRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcVGnRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcVGnRt,2), UBOUND(OutData%PFrcVGnRt,2) + DO i1 = LBOUND(OutData%PFrcVGnRt,1), UBOUND(OutData%PFrcVGnRt,1) + OutData%PFrcVGnRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcWTail not allocated Int_Xferred = Int_Xferred + 1 @@ -14781,15 +14644,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcWTail)>0) OutData%PFrcWTail = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcWTail))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcWTail) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcWTail,2), UBOUND(OutData%PFrcWTail,2) + DO i1 = LBOUND(OutData%PFrcWTail,1), UBOUND(OutData%PFrcWTail,1) + OutData%PFrcWTail(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcZAll not allocated Int_Xferred = Int_Xferred + 1 @@ -14807,15 +14667,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcZAll)>0) OutData%PFrcZAll = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcZAll))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcZAll) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcZAll,2), UBOUND(OutData%PFrcZAll,2) + DO i1 = LBOUND(OutData%PFrcZAll,1), UBOUND(OutData%PFrcZAll,1) + OutData%PFrcZAll(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomXAll not allocated Int_Xferred = Int_Xferred + 1 @@ -14833,24 +14690,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomXAll)>0) OutData%PMomXAll = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomXAll))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomXAll) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomXAll,2), UBOUND(OutData%PMomXAll,2) + DO i1 = LBOUND(OutData%PMomXAll,1), UBOUND(OutData%PMomXAll,1) + OutData%PMomXAll(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%TeetMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEffFac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TeetMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEffFac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCen not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14870,15 +14724,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rSAerCen)>0) OutData%rSAerCen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCen))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCen) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rSAerCen,3), UBOUND(OutData%rSAerCen,3) + DO i2 = LBOUND(OutData%rSAerCen,2), UBOUND(OutData%rSAerCen,2) + DO i1 = LBOUND(OutData%rSAerCen,1), UBOUND(OutData%rSAerCen,1) + OutData%rSAerCen(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE ED_UnPackRtHndSide @@ -15022,8 +14875,10 @@ SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QT))-1 ) = PACK(InData%QT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QT) + DO i1 = LBOUND(InData%QT,1), UBOUND(InData%QT,1) + DbKiBuf(Db_Xferred) = InData%QT(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QDT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -15035,8 +14890,10 @@ SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QDT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QDT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QDT))-1 ) = PACK(InData%QDT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QDT) + DO i1 = LBOUND(InData%QDT,1), UBOUND(InData%QDT,1) + DbKiBuf(Db_Xferred) = InData%QDT(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackContState @@ -15053,12 +14910,6 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15086,15 +14937,10 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QT)>0) OutData%QT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QT))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QT,1), UBOUND(OutData%QT,1) + OutData%QT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QDT not allocated Int_Xferred = Int_Xferred + 1 @@ -15109,15 +14955,10 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QDT)>0) OutData%QDT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QDT))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QDT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QDT,1), UBOUND(OutData%QDT,1) + OutData%QDT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackContState @@ -15212,8 +15053,8 @@ SUBROUTINE ED_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackDiscState SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15229,12 +15070,6 @@ SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackDiscState' @@ -15248,8 +15083,8 @@ SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackDiscState SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -15343,8 +15178,8 @@ SUBROUTINE ED_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackConstrState SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15360,12 +15195,6 @@ SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackConstrState' @@ -15379,8 +15208,8 @@ SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackConstrState SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -15531,8 +15360,8 @@ SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -15573,17 +15402,21 @@ SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IC)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IC))-1 ) = PACK(InData%IC,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IC) + DO i1 = LBOUND(InData%IC,1), UBOUND(InData%IC,1) + IntKiBuf(Int_Xferred) = InData%IC(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SgnPrvLSTQ - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SgnLSTQ))-1 ) = PACK(InData%SgnLSTQ,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SgnLSTQ) + ReKiBuf(Re_Xferred) = InData%HSSBrTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SgnPrvLSTQ + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SgnLSTQ,1), UBOUND(InData%SgnLSTQ,1) + IntKiBuf(Int_Xferred) = InData%SgnLSTQ(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE ED_PackOtherState SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15599,12 +15432,6 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15619,8 +15446,8 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -15678,33 +15505,23 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IC)>0) OutData%IC = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IC))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IC,1), UBOUND(OutData%IC,1) + OutData%IC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%HSSBrTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SgnPrvLSTQ = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%HSSBrTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SgnPrvLSTQ = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SgnLSTQ,1) i1_u = UBOUND(OutData%SgnLSTQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SgnLSTQ = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SgnLSTQ))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SgnLSTQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SgnLSTQ,1), UBOUND(OutData%SgnLSTQ,1) + OutData%SgnLSTQ(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE ED_UnPackOtherState SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -16053,8 +15870,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16069,8 +15888,12 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%AugMat))-1 ) = PACK(InData%AugMat,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%AugMat) + DO i2 = LBOUND(InData%AugMat,2), UBOUND(InData%AugMat,2) + DO i1 = LBOUND(InData%AugMat,1), UBOUND(InData%AugMat,1) + DbKiBuf(Db_Xferred) = InData%AugMat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat_factor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16085,8 +15908,12 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat_factor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%AugMat_factor))-1 ) = PACK(InData%AugMat_factor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%AugMat_factor) + DO i2 = LBOUND(InData%AugMat_factor,2), UBOUND(InData%AugMat_factor,2) + DO i1 = LBOUND(InData%AugMat_factor,1), UBOUND(InData%AugMat_factor,1) + DbKiBuf(Db_Xferred) = InData%AugMat_factor(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SolnVec) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16098,8 +15925,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SolnVec,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SolnVec)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SolnVec))-1 ) = PACK(InData%SolnVec,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SolnVec) + DO i1 = LBOUND(InData%SolnVec,1), UBOUND(InData%SolnVec,1) + DbKiBuf(Db_Xferred) = InData%SolnVec(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat_pivot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16111,8 +15940,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_pivot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat_pivot)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AugMat_pivot))-1 ) = PACK(InData%AugMat_pivot,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AugMat_pivot) + DO i1 = LBOUND(InData%AugMat_pivot,1), UBOUND(InData%AugMat_pivot,1) + IntKiBuf(Int_Xferred) = InData%AugMat_pivot(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OgnlGeAzRo) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16124,8 +15955,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OgnlGeAzRo,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OgnlGeAzRo)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OgnlGeAzRo))-1 ) = PACK(InData%OgnlGeAzRo,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OgnlGeAzRo) + DO i1 = LBOUND(InData%OgnlGeAzRo,1), UBOUND(InData%OgnlGeAzRo,1) + ReKiBuf(Re_Xferred) = InData%OgnlGeAzRo(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QD2T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16137,11 +15970,13 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QD2T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QD2T)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QD2T))-1 ) = PACK(InData%QD2T,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QD2T) + DO i1 = LBOUND(InData%QD2T,1), UBOUND(InData%QD2T,1) + DbKiBuf(Db_Xferred) = InData%QD2T(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IgnoreMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackMisc SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -16157,12 +15992,6 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -16271,15 +16100,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat not allocated Int_Xferred = Int_Xferred + 1 @@ -16297,15 +16121,12 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AugMat)>0) OutData%AugMat = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%AugMat))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%AugMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AugMat,2), UBOUND(OutData%AugMat,2) + DO i1 = LBOUND(OutData%AugMat,1), UBOUND(OutData%AugMat,1) + OutData%AugMat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_factor not allocated Int_Xferred = Int_Xferred + 1 @@ -16323,15 +16144,12 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AugMat_factor)>0) OutData%AugMat_factor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%AugMat_factor))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%AugMat_factor) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AugMat_factor,2), UBOUND(OutData%AugMat_factor,2) + DO i1 = LBOUND(OutData%AugMat_factor,1), UBOUND(OutData%AugMat_factor,1) + OutData%AugMat_factor(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SolnVec not allocated Int_Xferred = Int_Xferred + 1 @@ -16346,15 +16164,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SolnVec)>0) OutData%SolnVec = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SolnVec))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SolnVec) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SolnVec,1), UBOUND(OutData%SolnVec,1) + OutData%SolnVec(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_pivot not allocated Int_Xferred = Int_Xferred + 1 @@ -16369,15 +16182,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AugMat_pivot)>0) OutData%AugMat_pivot = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AugMat_pivot))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AugMat_pivot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AugMat_pivot,1), UBOUND(OutData%AugMat_pivot,1) + OutData%AugMat_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OgnlGeAzRo not allocated Int_Xferred = Int_Xferred + 1 @@ -16392,15 +16200,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%OgnlGeAzRo)>0) OutData%OgnlGeAzRo = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OgnlGeAzRo))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OgnlGeAzRo) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OgnlGeAzRo,1), UBOUND(OutData%OgnlGeAzRo,1) + OutData%OgnlGeAzRo(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QD2T not allocated Int_Xferred = Int_Xferred + 1 @@ -16415,18 +16218,13 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QD2T)>0) OutData%QD2T = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QD2T))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QD2T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QD2T,1), UBOUND(OutData%QD2T,1) + OutData%QD2T(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%IgnoreMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackMisc SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -17586,6 +17384,25 @@ SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt DstParamData%BD4Blades = SrcParamData%BD4Blades DstParamData%UseAD14 = SrcParamData%UseAD14 + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN i1_l = LBOUND(SrcParamData%Jac_u_indx,1) i1_u = UBOUND(SrcParamData%Jac_u_indx,1) @@ -17853,6 +17670,12 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%TElmntMass)) THEN DEALLOCATE(ParamData%TElmntMass) ENDIF +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF IF (ALLOCATED(ParamData%Jac_u_indx)) THEN DEALLOCATE(ParamData%Jac_u_indx) ENDIF @@ -18459,6 +18282,32 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_BufSz = Re_BufSz + 1 ! PtfmCMyt Int_BufSz = Int_BufSz + 1 ! BD4Blades Int_BufSz = Int_BufSz + 1 ! UseAD14 + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no IF ( ALLOCATED(InData%Jac_u_indx) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension @@ -18502,22 +18351,22 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT24 - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TipNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDOF - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TwoPiNB - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAug - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPH - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT24 + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TipNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDOF + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TwoPiNB + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAug + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPH + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PH) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18528,11 +18377,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PH,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PH)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PH))-1 ) = PACK(InData%PH,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PH) + DO i1 = LBOUND(InData%PH,1), UBOUND(InData%PH,1) + IntKiBuf(Int_Xferred) = InData%PH(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18546,8 +18397,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PM)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PM))-1 ) = PACK(InData%PM,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PM) + DO i2 = LBOUND(InData%PM,2), UBOUND(InData%PM,2) + DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) + IntKiBuf(Int_Xferred) = InData%PM(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DOF_Flag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18559,8 +18414,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Flag,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DOF_Flag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%DOF_Flag)-1 ) = TRANSFER(PACK( InData%DOF_Flag ,.TRUE.), IntKiBuf(1), SIZE(InData%DOF_Flag)) - Int_Xferred = Int_Xferred + SIZE(InData%DOF_Flag) + DO i1 = LBOUND(InData%DOF_Flag,1), UBOUND(InData%DOF_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%DOF_Flag(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DOF_Desc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18572,12 +18429,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Desc,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) + DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) DO I = 1, LEN(InData%DOF_Desc) IntKiBuf(Int_Xferred) = ICHAR(InData%DOF_Desc(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -18607,16 +18464,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NBlGages + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwGages + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18658,16 +18515,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgNrmTpRd - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CosDel3 - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%AvgNrmTpRd + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimB1Up + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CosDel3 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CosPreC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18678,111 +18535,113 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CosPreC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CosPreC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%CosPreC))-1 ) = PACK(InData%CosPreC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%CosPreC) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSRFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSRFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSTFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSTFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinBank - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ProjArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefTwrHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rZT0zt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rZYzt - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SinDel3 - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%CosPreC,1), UBOUND(InData%CosPreC,1) + DbKiBuf(Db_Xferred) = InData%CosPreC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%CRFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlTlt2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CShftSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CShftTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSRFrlSkw + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSRFrlTlt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSTFrlSkw + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSTFrlTlt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinBank + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlTlt2 + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubCM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OverHang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ProjArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefTwrHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rZT0zt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rZYzt + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SinDel3 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SinPreC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18793,51 +18652,53 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SinPreC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SinPreC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SinPreC))-1 ) = PACK(InData%SinPreC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SinPreC) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinBank - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SinPreC,1), UBOUND(InData%SinPreC,1) + DbKiBuf(Db_Xferred) = InData%SinPreC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%SRFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlTlt2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SShftSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SShftTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinBank + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlTlt2 + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBsHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UndSling + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AxRedTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18854,8 +18715,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedTFA))-1 ) = PACK(InData%AxRedTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedTFA) + DO i3 = LBOUND(InData%AxRedTFA,3), UBOUND(InData%AxRedTFA,3) + DO i2 = LBOUND(InData%AxRedTFA,2), UBOUND(InData%AxRedTFA,2) + DO i1 = LBOUND(InData%AxRedTFA,1), UBOUND(InData%AxRedTFA,1) + ReKiBuf(Re_Xferred) = InData%AxRedTFA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxRedTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18873,13 +18740,27 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedTSS))-1 ) = PACK(InData%AxRedTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedTSS) + DO i3 = LBOUND(InData%AxRedTSS,3), UBOUND(InData%AxRedTSS,3) + DO i2 = LBOUND(InData%AxRedTSS,2), UBOUND(InData%AxRedTSS,2) + DO i1 = LBOUND(InData%AxRedTSS,1), UBOUND(InData%AxRedTSS,1) + ReKiBuf(Re_Xferred) = InData%AxRedTSS(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTFA))-1 ) = PACK(InData%CTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTSS))-1 ) = PACK(InData%CTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTSS) + DO i2 = LBOUND(InData%CTFA,2), UBOUND(InData%CTFA,2) + DO i1 = LBOUND(InData%CTFA,1), UBOUND(InData%CTFA,1) + ReKiBuf(Re_Xferred) = InData%CTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%CTSS,2), UBOUND(InData%CTSS,2) + DO i1 = LBOUND(InData%CTSS,1), UBOUND(InData%CTSS,1) + ReKiBuf(Re_Xferred) = InData%CTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%DHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18890,8 +18771,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DHNodes))-1 ) = PACK(InData%DHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DHNodes) + DO i1 = LBOUND(InData%DHNodes,1), UBOUND(InData%DHNodes,1) + ReKiBuf(Re_Xferred) = InData%DHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18903,8 +18786,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HNodes))-1 ) = PACK(InData%HNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HNodes) + DO i1 = LBOUND(InData%HNodes,1), UBOUND(InData%HNodes,1) + ReKiBuf(Re_Xferred) = InData%HNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HNodesNorm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18916,13 +18801,23 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodesNorm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HNodesNorm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HNodesNorm))-1 ) = PACK(InData%HNodesNorm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HNodesNorm) + DO i1 = LBOUND(InData%HNodesNorm,1), UBOUND(InData%HNodesNorm,1) + ReKiBuf(Re_Xferred) = InData%HNodesNorm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KTFA))-1 ) = PACK(InData%KTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KTSS))-1 ) = PACK(InData%KTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KTSS) + DO i2 = LBOUND(InData%KTFA,2), UBOUND(InData%KTFA,2) + DO i1 = LBOUND(InData%KTFA,1), UBOUND(InData%KTFA,1) + ReKiBuf(Re_Xferred) = InData%KTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%KTSS,2), UBOUND(InData%KTSS,2) + DO i1 = LBOUND(InData%KTSS,1), UBOUND(InData%KTSS,1) + ReKiBuf(Re_Xferred) = InData%KTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%MassT) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18933,8 +18828,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MassT))-1 ) = PACK(InData%MassT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MassT) + DO i1 = LBOUND(InData%MassT,1), UBOUND(InData%MassT,1) + ReKiBuf(Re_Xferred) = InData%MassT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18946,8 +18843,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTSS))-1 ) = PACK(InData%StiffTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTSS) + DO i1 = LBOUND(InData%StiffTSS,1), UBOUND(InData%StiffTSS,1) + ReKiBuf(Re_Xferred) = InData%StiffTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrFASF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18965,11 +18864,17 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrFASF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrFASF))-1 ) = PACK(InData%TwrFASF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrFASF) + DO i3 = LBOUND(InData%TwrFASF,3), UBOUND(InData%TwrFASF,3) + DO i2 = LBOUND(InData%TwrFASF,2), UBOUND(InData%TwrFASF,2) + DO i1 = LBOUND(InData%TwrFASF,1), UBOUND(InData%TwrFASF,1) + ReKiBuf(Re_Xferred) = InData%TwrFASF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrFlexL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrFlexL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrSSSF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18986,13 +18891,19 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrSSSF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrSSSF))-1 ) = PACK(InData%TwrSSSF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrSSSF) + DO i3 = LBOUND(InData%TwrSSSF,3), UBOUND(InData%TwrSSSF,3) + DO i2 = LBOUND(InData%TwrSSSF,2), UBOUND(InData%TwrSSSF,2) + DO i1 = LBOUND(InData%TwrSSSF,1), UBOUND(InData%TwrSSSF,1) + ReKiBuf(Re_Xferred) = InData%TwrSSSF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TTopNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TTopNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InerTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19003,8 +18914,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerTFA))-1 ) = PACK(InData%InerTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerTFA) + DO i1 = LBOUND(InData%InerTFA,1), UBOUND(InData%InerTFA,1) + ReKiBuf(Re_Xferred) = InData%InerTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%InerTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19016,8 +18929,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerTSS))-1 ) = PACK(InData%InerTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerTSS) + DO i1 = LBOUND(InData%InerTSS,1), UBOUND(InData%InerTSS,1) + ReKiBuf(Re_Xferred) = InData%InerTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTGJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19029,8 +18944,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTGJ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTGJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTGJ))-1 ) = PACK(InData%StiffTGJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTGJ) + DO i1 = LBOUND(InData%StiffTGJ,1), UBOUND(InData%StiffTGJ,1) + ReKiBuf(Re_Xferred) = InData%StiffTGJ(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTEA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19042,8 +18959,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTEA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTEA))-1 ) = PACK(InData%StiffTEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTEA) + DO i1 = LBOUND(InData%StiffTEA,1), UBOUND(InData%StiffTEA,1) + ReKiBuf(Re_Xferred) = InData%StiffTEA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19055,8 +18974,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTFA))-1 ) = PACK(InData%StiffTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTFA) + DO i1 = LBOUND(InData%StiffTFA,1), UBOUND(InData%StiffTFA,1) + ReKiBuf(Re_Xferred) = InData%StiffTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19068,8 +18989,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffTFA))-1 ) = PACK(InData%cgOffTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffTFA) + DO i1 = LBOUND(InData%cgOffTFA,1), UBOUND(InData%cgOffTFA,1) + ReKiBuf(Re_Xferred) = InData%cgOffTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19081,11 +19004,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffTSS))-1 ) = PACK(InData%cgOffTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffTSS) + DO i1 = LBOUND(InData%cgOffTSS,1), UBOUND(InData%cgOffTSS,1) + ReKiBuf(Re_Xferred) = InData%cgOffTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AtfaIner - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AtfaIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BldCG) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19096,8 +19021,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldCG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldCG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldCG))-1 ) = PACK(InData%BldCG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldCG) + DO i1 = LBOUND(InData%BldCG,1), UBOUND(InData%BldCG,1) + ReKiBuf(Re_Xferred) = InData%BldCG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19109,11 +19036,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldMass))-1 ) = PACK(InData%BldMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldMass) + DO i1 = LBOUND(InData%BldMass,1), UBOUND(InData%BldMass,1) + ReKiBuf(Re_Xferred) = InData%BldMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomMass + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FirstMom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19124,37 +19053,39 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstMom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstMom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FirstMom))-1 ) = PACK(InData%FirstMom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FirstMom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Hubg1Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Hubg2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Nacd2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RrfaIner - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%FirstMom,1), UBOUND(InData%FirstMom,1) + ReKiBuf(Re_Xferred) = InData%FirstMom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%GenIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Hubg1Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Hubg2Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Nacd2Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RrfaIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SecondMom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19165,13 +19096,15 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SecondMom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SecondMom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SecondMom))-1 ) = PACK(InData%SecondMom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SecondMom) + DO i1 = LBOUND(InData%SecondMom,1), UBOUND(InData%SecondMom,1) + ReKiBuf(Re_Xferred) = InData%SecondMom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19182,19 +19115,21 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TipMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TipMass))-1 ) = PACK(InData%TipMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TipMass) + DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) + ReKiBuf(Re_Xferred) = InData%TipMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TurbMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrTpMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TurbMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrTpMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PitchAxis) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19208,8 +19143,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitchAxis)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitchAxis))-1 ) = PACK(InData%PitchAxis,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitchAxis) + DO i2 = LBOUND(InData%PitchAxis,2), UBOUND(InData%PitchAxis,2) + DO i1 = LBOUND(InData%PitchAxis,1), UBOUND(InData%PitchAxis,1) + ReKiBuf(Re_Xferred) = InData%PitchAxis(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19221,8 +19160,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroTwst))-1 ) = PACK(InData%AeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroTwst) + DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) + ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AxRedBld) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19243,8 +19184,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedBld)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedBld))-1 ) = PACK(InData%AxRedBld,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedBld) + DO i4 = LBOUND(InData%AxRedBld,4), UBOUND(InData%AxRedBld,4) + DO i3 = LBOUND(InData%AxRedBld,3), UBOUND(InData%AxRedBld,3) + DO i2 = LBOUND(InData%AxRedBld,2), UBOUND(InData%AxRedBld,2) + DO i1 = LBOUND(InData%AxRedBld,1), UBOUND(InData%AxRedBld,1) + ReKiBuf(Re_Xferred) = InData%AxRedBld(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BAlpha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19259,8 +19208,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BAlpha,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BAlpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BAlpha))-1 ) = PACK(InData%BAlpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BAlpha) + DO i2 = LBOUND(InData%BAlpha,2), UBOUND(InData%BAlpha,2) + DO i1 = LBOUND(InData%BAlpha,1), UBOUND(InData%BAlpha,1) + ReKiBuf(Re_Xferred) = InData%BAlpha(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19275,8 +19228,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEDamp))-1 ) = PACK(InData%BldEDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEDamp) + DO i2 = LBOUND(InData%BldEDamp,2), UBOUND(InData%BldEDamp,2) + DO i1 = LBOUND(InData%BldEDamp,1), UBOUND(InData%BldEDamp,1) + ReKiBuf(Re_Xferred) = InData%BldEDamp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19291,11 +19248,15 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFDamp))-1 ) = PACK(InData%BldFDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFDamp) + DO i2 = LBOUND(InData%BldFDamp,2), UBOUND(InData%BldFDamp,2) + DO i1 = LBOUND(InData%BldFDamp,1), UBOUND(InData%BldFDamp,1) + ReKiBuf(Re_Xferred) = InData%BldFDamp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BldFlexL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BldFlexL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CAeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19306,8 +19267,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CAeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CAeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CAeroTwst))-1 ) = PACK(InData%CAeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CAeroTwst) + DO i1 = LBOUND(InData%CAeroTwst,1), UBOUND(InData%CAeroTwst,1) + ReKiBuf(Re_Xferred) = InData%CAeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19325,8 +19288,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CBE))-1 ) = PACK(InData%CBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CBE) + DO i3 = LBOUND(InData%CBE,3), UBOUND(InData%CBE,3) + DO i2 = LBOUND(InData%CBE,2), UBOUND(InData%CBE,2) + DO i1 = LBOUND(InData%CBE,1), UBOUND(InData%CBE,1) + ReKiBuf(Re_Xferred) = InData%CBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19344,8 +19313,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CBF))-1 ) = PACK(InData%CBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CBF) + DO i3 = LBOUND(InData%CBF,3), UBOUND(InData%CBF,3) + DO i2 = LBOUND(InData%CBF,2), UBOUND(InData%CBF,2) + DO i1 = LBOUND(InData%CBF,1), UBOUND(InData%CBF,1) + ReKiBuf(Re_Xferred) = InData%CBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19360,8 +19335,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffBEdg))-1 ) = PACK(InData%cgOffBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffBEdg) + DO i2 = LBOUND(InData%cgOffBEdg,2), UBOUND(InData%cgOffBEdg,2) + DO i1 = LBOUND(InData%cgOffBEdg,1), UBOUND(InData%cgOffBEdg,1) + ReKiBuf(Re_Xferred) = InData%cgOffBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19376,8 +19355,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffBFlp))-1 ) = PACK(InData%cgOffBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffBFlp) + DO i2 = LBOUND(InData%cgOffBFlp,2), UBOUND(InData%cgOffBFlp,2) + DO i1 = LBOUND(InData%cgOffBFlp,1), UBOUND(InData%cgOffBFlp,1) + ReKiBuf(Re_Xferred) = InData%cgOffBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Chord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19389,8 +19372,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Chord))-1 ) = PACK(InData%Chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Chord) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19405,8 +19390,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CThetaS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%CThetaS))-1 ) = PACK(InData%CThetaS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%CThetaS) + DO i2 = LBOUND(InData%CThetaS,2), UBOUND(InData%CThetaS,2) + DO i1 = LBOUND(InData%CThetaS,1), UBOUND(InData%CThetaS,1) + DbKiBuf(Db_Xferred) = InData%CThetaS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19418,8 +19407,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DRNodes))-1 ) = PACK(InData%DRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DRNodes) + DO i1 = LBOUND(InData%DRNodes,1), UBOUND(InData%DRNodes,1) + ReKiBuf(Re_Xferred) = InData%DRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EAOffBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19434,8 +19425,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAOffBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAOffBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAOffBEdg))-1 ) = PACK(InData%EAOffBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAOffBEdg) + DO i2 = LBOUND(InData%EAOffBEdg,2), UBOUND(InData%EAOffBEdg,2) + DO i1 = LBOUND(InData%EAOffBEdg,1), UBOUND(InData%EAOffBEdg,1) + ReKiBuf(Re_Xferred) = InData%EAOffBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%EAOffBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19450,8 +19445,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAOffBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAOffBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAOffBFlp))-1 ) = PACK(InData%EAOffBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAOffBFlp) + DO i2 = LBOUND(InData%EAOffBFlp,2), UBOUND(InData%EAOffBFlp,2) + DO i1 = LBOUND(InData%EAOffBFlp,1), UBOUND(InData%EAOffBFlp,1) + ReKiBuf(Re_Xferred) = InData%EAOffBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FStTunr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19466,8 +19465,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FStTunr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FStTunr))-1 ) = PACK(InData%FStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FStTunr) + DO i2 = LBOUND(InData%FStTunr,2), UBOUND(InData%FStTunr,2) + DO i1 = LBOUND(InData%FStTunr,1), UBOUND(InData%FStTunr,1) + ReKiBuf(Re_Xferred) = InData%FStTunr(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InerBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19482,8 +19485,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerBEdg))-1 ) = PACK(InData%InerBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerBEdg) + DO i2 = LBOUND(InData%InerBEdg,2), UBOUND(InData%InerBEdg,2) + DO i1 = LBOUND(InData%InerBEdg,1), UBOUND(InData%InerBEdg,1) + ReKiBuf(Re_Xferred) = InData%InerBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InerBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19498,8 +19505,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerBFlp))-1 ) = PACK(InData%InerBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerBFlp) + DO i2 = LBOUND(InData%InerBFlp,2), UBOUND(InData%InerBFlp,2) + DO i1 = LBOUND(InData%InerBFlp,1), UBOUND(InData%InerBFlp,1) + ReKiBuf(Re_Xferred) = InData%InerBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19517,8 +19528,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBE))-1 ) = PACK(InData%KBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBE) + DO i3 = LBOUND(InData%KBE,3), UBOUND(InData%KBE,3) + DO i2 = LBOUND(InData%KBE,2), UBOUND(InData%KBE,2) + DO i1 = LBOUND(InData%KBE,1), UBOUND(InData%KBE,1) + ReKiBuf(Re_Xferred) = InData%KBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19536,8 +19553,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBF))-1 ) = PACK(InData%KBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBF) + DO i3 = LBOUND(InData%KBF,3), UBOUND(InData%KBF,3) + DO i2 = LBOUND(InData%KBF,2), UBOUND(InData%KBF,2) + DO i1 = LBOUND(InData%KBF,1), UBOUND(InData%KBF,1) + ReKiBuf(Re_Xferred) = InData%KBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19552,8 +19575,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MassB))-1 ) = PACK(InData%MassB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MassB) + DO i2 = LBOUND(InData%MassB,2), UBOUND(InData%MassB,2) + DO i1 = LBOUND(InData%MassB,1), UBOUND(InData%MassB,1) + ReKiBuf(Re_Xferred) = InData%MassB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RefAxisxb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19568,8 +19595,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RefAxisxb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RefAxisxb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RefAxisxb))-1 ) = PACK(InData%RefAxisxb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RefAxisxb) + DO i2 = LBOUND(InData%RefAxisxb,2), UBOUND(InData%RefAxisxb,2) + DO i1 = LBOUND(InData%RefAxisxb,1), UBOUND(InData%RefAxisxb,1) + ReKiBuf(Re_Xferred) = InData%RefAxisxb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RefAxisyb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19584,8 +19615,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RefAxisyb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RefAxisyb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RefAxisyb))-1 ) = PACK(InData%RefAxisyb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RefAxisyb) + DO i2 = LBOUND(InData%RefAxisyb,2), UBOUND(InData%RefAxisyb,2) + DO i1 = LBOUND(InData%RefAxisyb,1), UBOUND(InData%RefAxisyb,1) + ReKiBuf(Re_Xferred) = InData%RefAxisyb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19597,8 +19632,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodes))-1 ) = PACK(InData%RNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodes) + DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) + ReKiBuf(Re_Xferred) = InData%RNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RNodesNorm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19610,8 +19647,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodesNorm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodesNorm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodesNorm))-1 ) = PACK(InData%RNodesNorm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodesNorm) + DO i1 = LBOUND(InData%RNodesNorm,1), UBOUND(InData%RNodesNorm,1) + ReKiBuf(Re_Xferred) = InData%RNodesNorm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rSAerCenn1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19626,8 +19665,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCenn1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCenn1))-1 ) = PACK(InData%rSAerCenn1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCenn1) + DO i2 = LBOUND(InData%rSAerCenn1,2), UBOUND(InData%rSAerCenn1,2) + DO i1 = LBOUND(InData%rSAerCenn1,1), UBOUND(InData%rSAerCenn1,1) + ReKiBuf(Re_Xferred) = InData%rSAerCenn1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rSAerCenn2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19642,8 +19685,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCenn2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCenn2))-1 ) = PACK(InData%rSAerCenn2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCenn2) + DO i2 = LBOUND(InData%rSAerCenn2,2), UBOUND(InData%rSAerCenn2,2) + DO i1 = LBOUND(InData%rSAerCenn2,1), UBOUND(InData%rSAerCenn2,1) + ReKiBuf(Re_Xferred) = InData%rSAerCenn2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SAeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19655,8 +19702,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SAeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SAeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SAeroTwst))-1 ) = PACK(InData%SAeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SAeroTwst) + DO i1 = LBOUND(InData%SAeroTwst,1), UBOUND(InData%SAeroTwst,1) + ReKiBuf(Re_Xferred) = InData%SAeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19671,8 +19720,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBE))-1 ) = PACK(InData%StiffBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBE) + DO i2 = LBOUND(InData%StiffBE,2), UBOUND(InData%StiffBE,2) + DO i1 = LBOUND(InData%StiffBE,1), UBOUND(InData%StiffBE,1) + ReKiBuf(Re_Xferred) = InData%StiffBE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBEA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19687,8 +19740,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBEA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBEA))-1 ) = PACK(InData%StiffBEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBEA) + DO i2 = LBOUND(InData%StiffBEA,2), UBOUND(InData%StiffBEA,2) + DO i1 = LBOUND(InData%StiffBEA,1), UBOUND(InData%StiffBEA,1) + ReKiBuf(Re_Xferred) = InData%StiffBEA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19703,8 +19760,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBF))-1 ) = PACK(InData%StiffBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBF) + DO i2 = LBOUND(InData%StiffBF,2), UBOUND(InData%StiffBF,2) + DO i1 = LBOUND(InData%StiffBF,1), UBOUND(InData%StiffBF,1) + ReKiBuf(Re_Xferred) = InData%StiffBF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBGJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19719,8 +19780,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBGJ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBGJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBGJ))-1 ) = PACK(InData%StiffBGJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBGJ) + DO i2 = LBOUND(InData%StiffBGJ,2), UBOUND(InData%StiffBGJ,2) + DO i1 = LBOUND(InData%StiffBGJ,1), UBOUND(InData%StiffBGJ,1) + ReKiBuf(Re_Xferred) = InData%StiffBGJ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19735,8 +19800,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SThetaS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SThetaS))-1 ) = PACK(InData%SThetaS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SThetaS) + DO i2 = LBOUND(InData%SThetaS,2), UBOUND(InData%SThetaS,2) + DO i1 = LBOUND(InData%SThetaS,1), UBOUND(InData%SThetaS,1) + DbKiBuf(Db_Xferred) = InData%SThetaS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19751,8 +19820,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ThetaS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ThetaS))-1 ) = PACK(InData%ThetaS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ThetaS) + DO i2 = LBOUND(InData%ThetaS,2), UBOUND(InData%ThetaS,2) + DO i1 = LBOUND(InData%ThetaS,1), UBOUND(InData%ThetaS,1) + ReKiBuf(Re_Xferred) = InData%ThetaS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwistedSF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19776,8 +19849,18 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwistedSF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwistedSF))-1 ) = PACK(InData%TwistedSF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwistedSF) + DO i5 = LBOUND(InData%TwistedSF,5), UBOUND(InData%TwistedSF,5) + DO i4 = LBOUND(InData%TwistedSF,4), UBOUND(InData%TwistedSF,4) + DO i3 = LBOUND(InData%TwistedSF,3), UBOUND(InData%TwistedSF,3) + DO i2 = LBOUND(InData%TwistedSF,2), UBOUND(InData%TwistedSF,2) + DO i1 = LBOUND(InData%TwistedSF,1), UBOUND(InData%TwistedSF,1) + ReKiBuf(Re_Xferred) = InData%TwistedSF(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19792,8 +19875,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl1Sh))-1 ) = PACK(InData%BldFl1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl1Sh) + DO i2 = LBOUND(InData%BldFl1Sh,2), UBOUND(InData%BldFl1Sh,2) + DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19808,8 +19895,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl2Sh))-1 ) = PACK(InData%BldFl2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl2Sh) + DO i2 = LBOUND(InData%BldFl2Sh,2), UBOUND(InData%BldFl2Sh,2) + DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19824,8 +19915,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEdgSh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdgSh))-1 ) = PACK(InData%BldEdgSh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdgSh) + DO i2 = LBOUND(InData%BldEdgSh,2), UBOUND(InData%BldEdgSh,2) + DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) + ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FreqBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19843,8 +19938,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FreqBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqBE))-1 ) = PACK(InData%FreqBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqBE) + DO i3 = LBOUND(InData%FreqBE,3), UBOUND(InData%FreqBE,3) + DO i2 = LBOUND(InData%FreqBE,2), UBOUND(InData%FreqBE,2) + DO i1 = LBOUND(InData%FreqBE,1), UBOUND(InData%FreqBE,1) + ReKiBuf(Re_Xferred) = InData%FreqBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FreqBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19862,99 +19963,117 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FreqBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqBF))-1 ) = PACK(InData%FreqBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqBF) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqTFA))-1 ) = PACK(InData%FreqTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqTSS))-1 ) = PACK(InData%FreqTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqTSS) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BldGagNd))-1 ) = PACK(InData%BldGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BldGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwrGagNd))-1 ) = PACK(InData%TwrGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwrGagNd) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(InData%FreqBF,3), UBOUND(InData%FreqBF,3) + DO i2 = LBOUND(InData%FreqBF,2), UBOUND(InData%FreqBF,2) + DO i1 = LBOUND(InData%FreqBF,1), UBOUND(InData%FreqBF,1) + ReKiBuf(Re_Xferred) = InData%FreqBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%FreqTFA,2), UBOUND(InData%FreqTFA,2) + DO i1 = LBOUND(InData%FreqTFA,1), UBOUND(InData%FreqTFA,1) + ReKiBuf(Re_Xferred) = InData%FreqTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%FreqTSS,2), UBOUND(InData%FreqTSS,2) + DO i1 = LBOUND(InData%FreqTSS,1), UBOUND(InData%FreqTSS,1) + ReKiBuf(Re_Xferred) = InData%FreqTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%TeetCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmpP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSStP + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TeetMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSpr + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSpr + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftGagL + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) + IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) + IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%TStart + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBRatio + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%BElmntMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19968,8 +20087,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BElmntMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BElmntMass))-1 ) = PACK(InData%BElmntMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BElmntMass) + DO i2 = LBOUND(InData%BElmntMass,2), UBOUND(InData%BElmntMass,2) + DO i1 = LBOUND(InData%BElmntMass,1), UBOUND(InData%BElmntMass,1) + ReKiBuf(Re_Xferred) = InData%BElmntMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TElmntMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19981,19 +20104,68 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TElmntMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TElmntMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TElmntMass))-1 ) = PACK(InData%TElmntMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TElmntMass) + DO i1 = LBOUND(InData%TElmntMass,1), UBOUND(InData%TElmntMass,1) + ReKiBuf(Re_Xferred) = InData%TElmntMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMyt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BD4Blades, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BD4Blades , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseAD14 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -20007,8 +20179,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -20020,8 +20196,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%dx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -20033,11 +20211,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackParam SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -20053,12 +20233,6 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -20077,22 +20251,22 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DT24 = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%BldNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TipNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%NAug = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPH = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DT24 = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%BldNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TipNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwoPiNB = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%NAug = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPH = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PH not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20106,18 +20280,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PH)>0) OutData%PH = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PH))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PH) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PH,1), UBOUND(OutData%PH,1) + OutData%PH(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NPM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20134,15 +20303,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PM)>0) OutData%PM = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PM))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PM,2), UBOUND(OutData%PM,2) + DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) + OutData%PM(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Flag not allocated Int_Xferred = Int_Xferred + 1 @@ -20157,15 +20323,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DOF_Flag)>0) OutData%DOF_Flag = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DOF_Flag))-1 ), OutData%DOF_Flag), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%DOF_Flag) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DOF_Flag,1), UBOUND(OutData%DOF_Flag,1) + OutData%DOF_Flag(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DOF_Flag(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Desc not allocated Int_Xferred = Int_Xferred + 1 @@ -20180,19 +20341,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) + DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) DO I = 1, LEN(OutData%DOF_Desc) OutData%DOF_Desc(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -20234,16 +20388,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBlGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NBlGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20300,16 +20454,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AvgNrmTpRd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CosDel3 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AvgNrmTpRd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CosDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CosPreC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20323,118 +20477,113 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CosPreC)>0) OutData%CosPreC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%CosPreC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%CosPreC) - DEALLOCATE(mask1) - END IF - OutData%CRFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlSkw = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlTlt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlSkw = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlTlt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinBank = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubCM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%OverHang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ProjArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefTwrHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rZT0zt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rZYzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SinDel3 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%CosPreC,1), UBOUND(OutData%CosPreC,1) + OutData%CosPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%CRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSRFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSRFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSTFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSTFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinBank = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubCM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%OverHang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ProjArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefTwrHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rZT0zt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rZYzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SinDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SinPreC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20448,58 +20597,53 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SinPreC)>0) OutData%SinPreC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SinPreC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SinPreC) - DEALLOCATE(mask1) - END IF - OutData%SRFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinBank = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%TFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SinPreC,1), UBOUND(OutData%SinPreC,1) + OutData%SinPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%SRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinBank = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%TFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBsHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UndSling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTFA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20519,15 +20663,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AxRedTFA)>0) OutData%AxRedTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedTFA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedTFA) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AxRedTFA,3), UBOUND(OutData%AxRedTFA,3) + DO i2 = LBOUND(OutData%AxRedTFA,2), UBOUND(OutData%AxRedTFA,2) + DO i1 = LBOUND(OutData%AxRedTFA,1), UBOUND(OutData%AxRedTFA,1) + OutData%AxRedTFA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20548,42 +20691,35 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AxRedTSS)>0) OutData%AxRedTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedTSS))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedTSS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AxRedTSS,3), UBOUND(OutData%AxRedTSS,3) + DO i2 = LBOUND(OutData%AxRedTSS,2), UBOUND(OutData%AxRedTSS,2) + DO i1 = LBOUND(OutData%AxRedTSS,1), UBOUND(OutData%AxRedTSS,1) + OutData%AxRedTSS(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%CTFA,1) i1_u = UBOUND(OutData%CTFA,1) i2_l = LBOUND(OutData%CTFA,2) i2_u = UBOUND(OutData%CTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%CTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CTFA,2), UBOUND(OutData%CTFA,2) + DO i1 = LBOUND(OutData%CTFA,1), UBOUND(OutData%CTFA,1) + OutData%CTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%CTSS,1) i1_u = UBOUND(OutData%CTSS,1) i2_l = LBOUND(OutData%CTSS,2) i2_u = UBOUND(OutData%CTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%CTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTSS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CTSS,2), UBOUND(OutData%CTSS,2) + DO i1 = LBOUND(OutData%CTSS,1), UBOUND(OutData%CTSS,1) + OutData%CTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DHNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20597,15 +20733,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DHNodes)>0) OutData%DHNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DHNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DHNodes,1), UBOUND(OutData%DHNodes,1) + OutData%DHNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -20620,15 +20751,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HNodes)>0) OutData%HNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HNodes,1), UBOUND(OutData%HNodes,1) + OutData%HNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodesNorm not allocated Int_Xferred = Int_Xferred + 1 @@ -20643,42 +20769,31 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HNodesNorm)>0) OutData%HNodesNorm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HNodesNorm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HNodesNorm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HNodesNorm,1), UBOUND(OutData%HNodesNorm,1) + OutData%HNodesNorm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%KTFA,1) i1_u = UBOUND(OutData%KTFA,1) i2_l = LBOUND(OutData%KTFA,2) i2_u = UBOUND(OutData%KTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%KTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KTFA,2), UBOUND(OutData%KTFA,2) + DO i1 = LBOUND(OutData%KTFA,1), UBOUND(OutData%KTFA,1) + OutData%KTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%KTSS,1) i1_u = UBOUND(OutData%KTSS,1) i2_l = LBOUND(OutData%KTSS,2) i2_u = UBOUND(OutData%KTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%KTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KTSS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KTSS,2), UBOUND(OutData%KTSS,2) + DO i1 = LBOUND(OutData%KTSS,1), UBOUND(OutData%KTSS,1) + OutData%KTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassT not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20692,15 +20807,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MassT)>0) OutData%MassT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MassT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MassT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MassT,1), UBOUND(OutData%MassT,1) + OutData%MassT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20715,15 +20825,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTSS)>0) OutData%StiffTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTSS,1), UBOUND(OutData%StiffTSS,1) + OutData%StiffTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFASF not allocated Int_Xferred = Int_Xferred + 1 @@ -20744,18 +20849,17 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrFASF)>0) OutData%TwrFASF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrFASF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrFASF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrFASF,3), UBOUND(OutData%TwrFASF,3) + DO i2 = LBOUND(OutData%TwrFASF,2), UBOUND(OutData%TwrFASF,2) + DO i1 = LBOUND(OutData%TwrFASF,1), UBOUND(OutData%TwrFASF,1) + OutData%TwrFASF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%TwrFlexL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TwrFlexL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrSSSF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20775,20 +20879,19 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrSSSF)>0) OutData%TwrSSSF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrSSSF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrSSSF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrSSSF,3), UBOUND(OutData%TwrSSSF,3) + DO i2 = LBOUND(OutData%TwrSSSF,2), UBOUND(OutData%TwrSSSF,2) + DO i1 = LBOUND(OutData%TwrSSSF,1), UBOUND(OutData%TwrSSSF,1) + OutData%TwrSSSF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%TTopNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TTopNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerTFA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20802,15 +20905,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InerTFA)>0) OutData%InerTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InerTFA,1), UBOUND(OutData%InerTFA,1) + OutData%InerTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20825,15 +20923,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InerTSS)>0) OutData%InerTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InerTSS,1), UBOUND(OutData%InerTSS,1) + OutData%InerTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTGJ not allocated Int_Xferred = Int_Xferred + 1 @@ -20848,15 +20941,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTGJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTGJ)>0) OutData%StiffTGJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTGJ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTGJ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTGJ,1), UBOUND(OutData%StiffTGJ,1) + OutData%StiffTGJ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTEA not allocated Int_Xferred = Int_Xferred + 1 @@ -20871,15 +20959,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTEA)>0) OutData%StiffTEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTEA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTEA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTEA,1), UBOUND(OutData%StiffTEA,1) + OutData%StiffTEA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTFA not allocated Int_Xferred = Int_Xferred + 1 @@ -20894,15 +20977,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTFA)>0) OutData%StiffTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTFA,1), UBOUND(OutData%StiffTFA,1) + OutData%StiffTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffTFA not allocated Int_Xferred = Int_Xferred + 1 @@ -20917,15 +20995,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%cgOffTFA)>0) OutData%cgOffTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%cgOffTFA,1), UBOUND(OutData%cgOffTFA,1) + OutData%cgOffTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20940,18 +21013,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%cgOffTSS)>0) OutData%cgOffTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%cgOffTSS,1), UBOUND(OutData%cgOffTSS,1) + OutData%cgOffTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%AtfaIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AtfaIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldCG not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20965,15 +21033,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldCG)>0) OutData%BldCG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldCG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldCG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldCG,1), UBOUND(OutData%BldCG,1) + OutData%BldCG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldMass not allocated Int_Xferred = Int_Xferred + 1 @@ -20988,18 +21051,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldMass)>0) OutData%BldMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldMass,1), UBOUND(OutData%BldMass,1) + OutData%BldMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BoomMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BoomMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstMom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21013,44 +21071,39 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FirstMom)>0) OutData%FirstMom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FirstMom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FirstMom) - DEALLOCATE(mask1) - END IF - OutData%GenIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg1Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg2Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Nacd2Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RrfaIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%FirstMom,1), UBOUND(OutData%FirstMom,1) + OutData%FirstMom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%GenIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Hubg1Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Hubg2Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Nacd2Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RrfaIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SecondMom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21064,20 +21117,15 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SecondMom)>0) OutData%SecondMom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SecondMom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SecondMom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SecondMom,1), UBOUND(OutData%SecondMom,1) + OutData%SecondMom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%TFinMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TFinMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21091,26 +21139,21 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TipMass)>0) OutData%TipMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TipMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TipMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) + OutData%TipMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%TurbMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrTpMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TurbMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrTpMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAxis not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21127,15 +21170,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PitchAxis)>0) OutData%PitchAxis = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitchAxis))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitchAxis) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PitchAxis,2), UBOUND(OutData%PitchAxis,2) + DO i1 = LBOUND(OutData%PitchAxis,1), UBOUND(OutData%PitchAxis,1) + OutData%PitchAxis(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -21150,15 +21190,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AeroTwst)>0) OutData%AeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) + OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedBld not allocated Int_Xferred = Int_Xferred + 1 @@ -21182,15 +21217,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%AxRedBld)>0) OutData%AxRedBld = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedBld))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedBld) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%AxRedBld,4), UBOUND(OutData%AxRedBld,4) + DO i3 = LBOUND(OutData%AxRedBld,3), UBOUND(OutData%AxRedBld,3) + DO i2 = LBOUND(OutData%AxRedBld,2), UBOUND(OutData%AxRedBld,2) + DO i1 = LBOUND(OutData%AxRedBld,1), UBOUND(OutData%AxRedBld,1) + OutData%AxRedBld(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BAlpha not allocated Int_Xferred = Int_Xferred + 1 @@ -21208,15 +21244,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BAlpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BAlpha)>0) OutData%BAlpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BAlpha))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BAlpha) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BAlpha,2), UBOUND(OutData%BAlpha,2) + DO i1 = LBOUND(OutData%BAlpha,1), UBOUND(OutData%BAlpha,1) + OutData%BAlpha(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -21234,15 +21267,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldEDamp)>0) OutData%BldEDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEDamp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEDamp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldEDamp,2), UBOUND(OutData%BldEDamp,2) + DO i1 = LBOUND(OutData%BldEDamp,1), UBOUND(OutData%BldEDamp,1) + OutData%BldEDamp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -21260,18 +21290,15 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFDamp)>0) OutData%BldFDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFDamp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFDamp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFDamp,2), UBOUND(OutData%BldFDamp,2) + DO i1 = LBOUND(OutData%BldFDamp,1), UBOUND(OutData%BldFDamp,1) + OutData%BldFDamp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%BldFlexL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BldFlexL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CAeroTwst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21285,15 +21312,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CAeroTwst)>0) OutData%CAeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CAeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CAeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CAeroTwst,1), UBOUND(OutData%CAeroTwst,1) + OutData%CAeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21314,15 +21336,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CBE)>0) OutData%CBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CBE,3), UBOUND(OutData%CBE,3) + DO i2 = LBOUND(OutData%CBE,2), UBOUND(OutData%CBE,2) + DO i1 = LBOUND(OutData%CBE,1), UBOUND(OutData%CBE,1) + OutData%CBE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21343,15 +21364,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CBF)>0) OutData%CBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CBF,3), UBOUND(OutData%CBF,3) + DO i2 = LBOUND(OutData%CBF,2), UBOUND(OutData%CBF,2) + DO i1 = LBOUND(OutData%CBF,1), UBOUND(OutData%CBF,1) + OutData%CBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21369,15 +21389,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%cgOffBEdg)>0) OutData%cgOffBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%cgOffBEdg,2), UBOUND(OutData%cgOffBEdg,2) + DO i1 = LBOUND(OutData%cgOffBEdg,1), UBOUND(OutData%cgOffBEdg,1) + OutData%cgOffBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21395,15 +21412,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%cgOffBFlp)>0) OutData%cgOffBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%cgOffBFlp,2), UBOUND(OutData%cgOffBFlp,2) + DO i1 = LBOUND(OutData%cgOffBFlp,1), UBOUND(OutData%cgOffBFlp,1) + OutData%cgOffBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated Int_Xferred = Int_Xferred + 1 @@ -21418,15 +21432,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Chord)>0) OutData%Chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Chord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Chord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -21444,15 +21453,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CThetaS)>0) OutData%CThetaS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%CThetaS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%CThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CThetaS,2), UBOUND(OutData%CThetaS,2) + DO i1 = LBOUND(OutData%CThetaS,1), UBOUND(OutData%CThetaS,1) + OutData%CThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DRNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -21467,15 +21473,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DRNodes)>0) OutData%DRNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DRNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DRNodes,1), UBOUND(OutData%DRNodes,1) + OutData%DRNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAOffBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21493,15 +21494,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAOffBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%EAOffBEdg)>0) OutData%EAOffBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAOffBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAOffBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EAOffBEdg,2), UBOUND(OutData%EAOffBEdg,2) + DO i1 = LBOUND(OutData%EAOffBEdg,1), UBOUND(OutData%EAOffBEdg,1) + OutData%EAOffBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAOffBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21519,15 +21517,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAOffBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%EAOffBFlp)>0) OutData%EAOffBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAOffBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAOffBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EAOffBFlp,2), UBOUND(OutData%EAOffBFlp,2) + DO i1 = LBOUND(OutData%EAOffBFlp,1), UBOUND(OutData%EAOffBFlp,1) + OutData%EAOffBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FStTunr not allocated Int_Xferred = Int_Xferred + 1 @@ -21545,15 +21540,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FStTunr)>0) OutData%FStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FStTunr))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FStTunr) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FStTunr,2), UBOUND(OutData%FStTunr,2) + DO i1 = LBOUND(OutData%FStTunr,1), UBOUND(OutData%FStTunr,1) + OutData%FStTunr(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21571,15 +21563,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InerBEdg)>0) OutData%InerBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InerBEdg,2), UBOUND(OutData%InerBEdg,2) + DO i1 = LBOUND(OutData%InerBEdg,1), UBOUND(OutData%InerBEdg,1) + OutData%InerBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21597,15 +21586,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InerBFlp)>0) OutData%InerBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InerBFlp,2), UBOUND(OutData%InerBFlp,2) + DO i1 = LBOUND(OutData%InerBFlp,1), UBOUND(OutData%InerBFlp,1) + OutData%InerBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21626,15 +21612,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%KBE)>0) OutData%KBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%KBE,3), UBOUND(OutData%KBE,3) + DO i2 = LBOUND(OutData%KBE,2), UBOUND(OutData%KBE,2) + DO i1 = LBOUND(OutData%KBE,1), UBOUND(OutData%KBE,1) + OutData%KBE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21655,15 +21640,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%KBF)>0) OutData%KBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%KBF,3), UBOUND(OutData%KBF,3) + DO i2 = LBOUND(OutData%KBF,2), UBOUND(OutData%KBF,2) + DO i1 = LBOUND(OutData%KBF,1), UBOUND(OutData%KBF,1) + OutData%KBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassB not allocated Int_Xferred = Int_Xferred + 1 @@ -21681,15 +21665,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MassB)>0) OutData%MassB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MassB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MassB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MassB,2), UBOUND(OutData%MassB,2) + DO i1 = LBOUND(OutData%MassB,1), UBOUND(OutData%MassB,1) + OutData%MassB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RefAxisxb not allocated Int_Xferred = Int_Xferred + 1 @@ -21707,15 +21688,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RefAxisxb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RefAxisxb)>0) OutData%RefAxisxb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RefAxisxb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RefAxisxb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RefAxisxb,2), UBOUND(OutData%RefAxisxb,2) + DO i1 = LBOUND(OutData%RefAxisxb,1), UBOUND(OutData%RefAxisxb,1) + OutData%RefAxisxb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RefAxisyb not allocated Int_Xferred = Int_Xferred + 1 @@ -21733,15 +21711,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RefAxisyb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RefAxisyb)>0) OutData%RefAxisyb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RefAxisyb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RefAxisyb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RefAxisyb,2), UBOUND(OutData%RefAxisyb,2) + DO i1 = LBOUND(OutData%RefAxisyb,1), UBOUND(OutData%RefAxisyb,1) + OutData%RefAxisyb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -21756,15 +21731,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodes)>0) OutData%RNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) + OutData%RNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodesNorm not allocated Int_Xferred = Int_Xferred + 1 @@ -21779,15 +21749,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodesNorm)>0) OutData%RNodesNorm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodesNorm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodesNorm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodesNorm,1), UBOUND(OutData%RNodesNorm,1) + OutData%RNodesNorm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn1 not allocated Int_Xferred = Int_Xferred + 1 @@ -21805,15 +21770,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rSAerCenn1)>0) OutData%rSAerCenn1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCenn1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCenn1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rSAerCenn1,2), UBOUND(OutData%rSAerCenn1,2) + DO i1 = LBOUND(OutData%rSAerCenn1,1), UBOUND(OutData%rSAerCenn1,1) + OutData%rSAerCenn1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn2 not allocated Int_Xferred = Int_Xferred + 1 @@ -21831,15 +21793,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rSAerCenn2)>0) OutData%rSAerCenn2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCenn2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCenn2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rSAerCenn2,2), UBOUND(OutData%rSAerCenn2,2) + DO i1 = LBOUND(OutData%rSAerCenn2,1), UBOUND(OutData%rSAerCenn2,1) + OutData%rSAerCenn2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SAeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -21854,15 +21813,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SAeroTwst)>0) OutData%SAeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SAeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SAeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SAeroTwst,1), UBOUND(OutData%SAeroTwst,1) + OutData%SAeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21880,15 +21834,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBE)>0) OutData%StiffBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBE,2), UBOUND(OutData%StiffBE,2) + DO i1 = LBOUND(OutData%StiffBE,1), UBOUND(OutData%StiffBE,1) + OutData%StiffBE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBEA not allocated Int_Xferred = Int_Xferred + 1 @@ -21906,15 +21857,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBEA)>0) OutData%StiffBEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBEA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBEA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBEA,2), UBOUND(OutData%StiffBEA,2) + DO i1 = LBOUND(OutData%StiffBEA,1), UBOUND(OutData%StiffBEA,1) + OutData%StiffBEA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21932,15 +21880,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBF)>0) OutData%StiffBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBF,2), UBOUND(OutData%StiffBF,2) + DO i1 = LBOUND(OutData%StiffBF,1), UBOUND(OutData%StiffBF,1) + OutData%StiffBF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBGJ not allocated Int_Xferred = Int_Xferred + 1 @@ -21958,15 +21903,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBGJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBGJ)>0) OutData%StiffBGJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBGJ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBGJ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBGJ,2), UBOUND(OutData%StiffBGJ,2) + DO i1 = LBOUND(OutData%StiffBGJ,1), UBOUND(OutData%StiffBGJ,1) + OutData%StiffBGJ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -21984,15 +21926,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SThetaS)>0) OutData%SThetaS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SThetaS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SThetaS,2), UBOUND(OutData%SThetaS,2) + DO i1 = LBOUND(OutData%SThetaS,1), UBOUND(OutData%SThetaS,1) + OutData%SThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -22010,15 +21949,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ThetaS)>0) OutData%ThetaS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ThetaS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ThetaS,2), UBOUND(OutData%ThetaS,2) + DO i1 = LBOUND(OutData%ThetaS,1), UBOUND(OutData%ThetaS,1) + OutData%ThetaS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwistedSF not allocated Int_Xferred = Int_Xferred + 1 @@ -22045,15 +21981,18 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%TwistedSF)>0) OutData%TwistedSF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwistedSF))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwistedSF) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%TwistedSF,5), UBOUND(OutData%TwistedSF,5) + DO i4 = LBOUND(OutData%TwistedSF,4), UBOUND(OutData%TwistedSF,4) + DO i3 = LBOUND(OutData%TwistedSF,3), UBOUND(OutData%TwistedSF,3) + DO i2 = LBOUND(OutData%TwistedSF,2), UBOUND(OutData%TwistedSF,2) + DO i1 = LBOUND(OutData%TwistedSF,1), UBOUND(OutData%TwistedSF,1) + OutData%TwistedSF(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -22071,15 +22010,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFl1Sh)>0) OutData%BldFl1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl1Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl1Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFl1Sh,2), UBOUND(OutData%BldFl1Sh,2) + DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) + OutData%BldFl1Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -22097,15 +22033,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFl2Sh)>0) OutData%BldFl2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl2Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl2Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFl2Sh,2), UBOUND(OutData%BldFl2Sh,2) + DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) + OutData%BldFl2Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated Int_Xferred = Int_Xferred + 1 @@ -22123,15 +22056,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldEdgSh)>0) OutData%BldEdgSh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdgSh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdgSh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldEdgSh,2), UBOUND(OutData%BldEdgSh,2) + DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) + OutData%BldEdgSh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBE not allocated Int_Xferred = Int_Xferred + 1 @@ -22152,15 +22082,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FreqBE)>0) OutData%FreqBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FreqBE,3), UBOUND(OutData%FreqBE,3) + DO i2 = LBOUND(OutData%FreqBE,2), UBOUND(OutData%FreqBE,2) + DO i1 = LBOUND(OutData%FreqBE,1), UBOUND(OutData%FreqBE,1) + OutData%FreqBE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBF not allocated Int_Xferred = Int_Xferred + 1 @@ -22181,146 +22110,129 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FreqBF)>0) OutData%FreqBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FreqBF,3), UBOUND(OutData%FreqBF,3) + DO i2 = LBOUND(OutData%FreqBF,2), UBOUND(OutData%FreqBF,2) + DO i1 = LBOUND(OutData%FreqBF,1), UBOUND(OutData%FreqBF,1) + OutData%FreqBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%FreqTFA,1) i1_u = UBOUND(OutData%FreqTFA,1) i2_l = LBOUND(OutData%FreqTFA,2) i2_u = UBOUND(OutData%FreqTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%FreqTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FreqTFA,2), UBOUND(OutData%FreqTFA,2) + DO i1 = LBOUND(OutData%FreqTFA,1), UBOUND(OutData%FreqTFA,1) + OutData%FreqTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%FreqTSS,1) i1_u = UBOUND(OutData%FreqTSS,1) i2_l = LBOUND(OutData%FreqTSS,2) i2_u = UBOUND(OutData%FreqTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%FreqTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqTSS) - DEALLOCATE(mask2) - OutData%TeetCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmpP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ShftGagL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%FreqTSS,2), UBOUND(OutData%FreqTSS,2) + DO i1 = LBOUND(OutData%FreqTSS,1), UBOUND(OutData%FreqTSS,1) + OutData%FreqTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%TeetCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmpP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShftGagL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%BldGagNd,1) i1_u = UBOUND(OutData%BldGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BldGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BldGagNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) + OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrGagNd,1) i1_u = UBOUND(OutData%TwrGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwrGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwrGagNd) - DEALLOCATE(mask1) - OutData%TStart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DTTorDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) + OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%TStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTTorDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BElmntMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -22337,15 +22249,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BElmntMass)>0) OutData%BElmntMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BElmntMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BElmntMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BElmntMass,2), UBOUND(OutData%BElmntMass,2) + DO i1 = LBOUND(OutData%BElmntMass,1), UBOUND(OutData%BElmntMass,1) + OutData%BElmntMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TElmntMass not allocated Int_Xferred = Int_Xferred + 1 @@ -22360,26 +22269,83 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%TElmntMass,1), UBOUND(OutData%TElmntMass,1) + OutData%TElmntMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmCMxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMyt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BD4Blades = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD4Blades) + Int_Xferred = Int_Xferred + 1 + OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%TElmntMass)>0) OutData%TElmntMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TElmntMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TElmntMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO END IF - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BD4Blades = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseAD14 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -22396,15 +22362,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -22419,15 +22382,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + 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 @@ -22442,18 +22400,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%dx)>0) OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackParam SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -22899,11 +22852,21 @@ SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrAddedMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrAddedMass))-1 ) = PACK(InData%TwrAddedMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrAddedMass) + DO i3 = LBOUND(InData%TwrAddedMass,3), UBOUND(InData%TwrAddedMass,3) + DO i2 = LBOUND(InData%TwrAddedMass,2), UBOUND(InData%TwrAddedMass,2) + DO i1 = LBOUND(InData%TwrAddedMass,1), UBOUND(InData%TwrAddedMass,1) + ReKiBuf(Re_Xferred) = InData%TwrAddedMass(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAddedMass))-1 ) = PACK(InData%PtfmAddedMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAddedMass) + DO i2 = LBOUND(InData%PtfmAddedMass,2), UBOUND(InData%PtfmAddedMass,2) + DO i1 = LBOUND(InData%PtfmAddedMass,1), UBOUND(InData%PtfmAddedMass,1) + ReKiBuf(Re_Xferred) = InData%PtfmAddedMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -22914,15 +22877,17 @@ SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackInput SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -22938,12 +22903,6 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -23195,29 +23154,25 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrAddedMass)>0) OutData%TwrAddedMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrAddedMass))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrAddedMass) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrAddedMass,3), UBOUND(OutData%TwrAddedMass,3) + DO i2 = LBOUND(OutData%TwrAddedMass,2), UBOUND(OutData%TwrAddedMass,2) + DO i1 = LBOUND(OutData%TwrAddedMass,1), UBOUND(OutData%TwrAddedMass,1) + OutData%TwrAddedMass(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%PtfmAddedMass,1) i1_u = UBOUND(OutData%PtfmAddedMass,1) i2_l = LBOUND(OutData%PtfmAddedMass,2) i2_u = UBOUND(OutData%PtfmAddedMass,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAddedMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAddedMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAddedMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAddedMass,2), UBOUND(OutData%PtfmAddedMass,2) + DO i1 = LBOUND(OutData%PtfmAddedMass,1), UBOUND(OutData%PtfmAddedMass,1) + OutData%PtfmAddedMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -23231,22 +23186,17 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchCom)>0) OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%YawMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%YawMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackInput SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -24000,8 +23950,10 @@ SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -24013,55 +23965,61 @@ SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMyc))-1 ) = PACK(InData%RootMyc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMyc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMxc))-1 ) = PACK(InData%RootMxc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMxc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrAccel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAngle + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackOutput SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -24077,12 +24035,6 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -24542,15 +24494,10 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 @@ -24565,80 +24512,65 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrAccel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMyc,1) i1_u = UBOUND(OutData%RootMyc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMyc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMyc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMyc) - DEALLOCATE(mask1) - OutData%YawBrTAxp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMxc,1) i1_u = UBOUND(OutData%RootMxc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMxc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMxc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMxc) - DEALLOCATE(mask1) - OutData%LSSTipMxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackOutput @@ -24716,17 +24648,16 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24739,9 +24670,11 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i01 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp1(u1%BladePtLoads(i01), u2%BladePtLoads(i01), tin, u_out%BladePtLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -24754,35 +24687,32 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - ALLOCATE(b3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - ALLOCATE(c3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - b3 = -(u1%TwrAddedMass - u2%TwrAddedMass)/t(2) - u_out%TwrAddedMass = u1%TwrAddedMass + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) + DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) + DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) + b = -(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated - ALLOCATE(b2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - ALLOCATE(c2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - b2 = -(u1%PtfmAddedMass - u2%PtfmAddedMass)/t(2) - u_out%PtfmAddedMass = u1%PtfmAddedMass + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) + DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) + b = -(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b * ScaleFactor + END DO + END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%BlPitchCom,1))) - b1 = -(u1%BlPitchCom - u2%BlPitchCom)/t(2) - u_out%BlPitchCom = u1%BlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(u1%YawMom - u2%YawMom)/t(2) - u_out%YawMom = u1%YawMom + b0 * t_out - b0 = -(u1%GenTrq - u2%GenTrq)/t(2) - u_out%GenTrq = u1%GenTrq + b0 * t_out - b0 = -(u1%HSSBrTrqC - u2%HSSBrTrqC)/t(2) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b0 * t_out + b = -(u1%YawMom - u2%YawMom) + u_out%YawMom = u1%YawMom + b * ScaleFactor + b = -(u1%GenTrq - u2%GenTrq) + u_out%GenTrq = u1%GenTrq + b * ScaleFactor + b = -(u1%HSSBrTrqC - u2%HSSBrTrqC) + u_out%HSSBrTrqC = u1%HSSBrTrqC + b * ScaleFactor END SUBROUTINE ED_Input_ExtrapInterp1 @@ -24812,18 +24742,18 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24842,9 +24772,11 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i01 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp2(u1%BladePtLoads(i01), u2%BladePtLoads(i01), u3%BladePtLoads(i01), tin, u_out%BladePtLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -24857,41 +24789,37 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - ALLOCATE(b3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - ALLOCATE(c3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - b3 = (t(3)**2*(u1%TwrAddedMass - u2%TwrAddedMass) + t(2)**2*(-u1%TwrAddedMass + u3%TwrAddedMass))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%TwrAddedMass + t(3)*u2%TwrAddedMass - t(2)*u3%TwrAddedMass ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TwrAddedMass = u1%TwrAddedMass + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) + DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) + DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) + b = (t(3)**2*(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + t(2)**2*(-u1%TwrAddedMass(i1,i2,i3) + u3%TwrAddedMass(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%TwrAddedMass(i1,i2,i3) + t(3)*u2%TwrAddedMass(i1,i2,i3) - t(2)*u3%TwrAddedMass(i1,i2,i3) ) * scaleFactor + u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated - ALLOCATE(b2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - ALLOCATE(c2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - b2 = (t(3)**2*(u1%PtfmAddedMass - u2%PtfmAddedMass) + t(2)**2*(-u1%PtfmAddedMass + u3%PtfmAddedMass))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%PtfmAddedMass + t(3)*u2%PtfmAddedMass - t(2)*u3%PtfmAddedMass ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PtfmAddedMass = u1%PtfmAddedMass + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) + DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) + b = (t(3)**2*(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + t(2)**2*(-u1%PtfmAddedMass(i1,i2) + u3%PtfmAddedMass(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%PtfmAddedMass(i1,i2) + t(3)*u2%PtfmAddedMass(i1,i2) - t(2)*u3%PtfmAddedMass(i1,i2) ) * scaleFactor + u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b + c * t_out + END DO + END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%BlPitchCom,1))) - b1 = (t(3)**2*(u1%BlPitchCom - u2%BlPitchCom) + t(2)**2*(-u1%BlPitchCom + u3%BlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%BlPitchCom + t(3)*u2%BlPitchCom - t(2)*u3%BlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BlPitchCom = u1%BlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawMom = u1%YawMom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%GenTrq = u1%GenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor + c = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) * scaleFactor + u_out%YawMom = u1%YawMom + b + c * t_out + b = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))* scaleFactor + c = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) * scaleFactor + u_out%GenTrq = u1%GenTrq + b + c * t_out + b = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))* scaleFactor + c = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) * scaleFactor + u_out%HSSBrTrqC = u1%HSSBrTrqC + b + c * t_out END SUBROUTINE ED_Input_ExtrapInterp2 @@ -24969,13 +24897,12 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24988,9 +24915,11 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i01 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i01), y2%BladeLn2Mesh(i01), tin, y_out%BladeLn2Mesh(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25005,8 +24934,8 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i01 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(y1%BladeRootMotion(i01), y2%BladeRootMotion(i01), tin, y_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25017,75 +24946,63 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitch,1))) - ALLOCATE(c1(SIZE(y_out%BlPitch,1))) - b1 = -(y1%BlPitch - y2%BlPitch)/t(2) - y_out%BlPitch = y1%BlPitch + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(y1%Yaw - y2%Yaw)/t(2) - y_out%Yaw = y1%Yaw + b0 * t_out - b0 = -(y1%YawRate - y2%YawRate)/t(2) - y_out%YawRate = y1%YawRate + b0 * t_out - b0 = -(y1%LSS_Spd - y2%LSS_Spd)/t(2) - y_out%LSS_Spd = y1%LSS_Spd + b0 * t_out - b0 = -(y1%HSS_Spd - y2%HSS_Spd)/t(2) - y_out%HSS_Spd = y1%HSS_Spd + b0 * t_out - b0 = -(y1%RotSpeed - y2%RotSpeed)/t(2) - y_out%RotSpeed = y1%RotSpeed + b0 * t_out - b0 = -(y1%TwrAccel - y2%TwrAccel)/t(2) - y_out%TwrAccel = y1%TwrAccel + b0 * t_out - b0 = -(y1%YawAngle - y2%YawAngle)/t(2) - y_out%YawAngle = y1%YawAngle + b0 * t_out - ALLOCATE(b1(SIZE(y_out%RootMyc,1))) - ALLOCATE(c1(SIZE(y_out%RootMyc,1))) - b1 = -(y1%RootMyc - y2%RootMyc)/t(2) - y_out%RootMyc = y1%RootMyc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(y1%YawBrTAxp - y2%YawBrTAxp)/t(2) - y_out%YawBrTAxp = y1%YawBrTAxp + b0 * t_out - b0 = -(y1%YawBrTAyp - y2%YawBrTAyp)/t(2) - y_out%YawBrTAyp = y1%YawBrTAyp + b0 * t_out - b0 = -(y1%LSSTipPxa - y2%LSSTipPxa)/t(2) - y_out%LSSTipPxa = y1%LSSTipPxa + b0 * t_out - ALLOCATE(b1(SIZE(y_out%RootMxc,1))) - ALLOCATE(c1(SIZE(y_out%RootMxc,1))) - b1 = -(y1%RootMxc - y2%RootMxc)/t(2) - y_out%RootMxc = y1%RootMxc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(y1%LSSTipMxa - y2%LSSTipMxa)/t(2) - y_out%LSSTipMxa = y1%LSSTipMxa + b0 * t_out - b0 = -(y1%LSSTipMya - y2%LSSTipMya)/t(2) - y_out%LSSTipMya = y1%LSSTipMya + b0 * t_out - b0 = -(y1%LSSTipMza - y2%LSSTipMza)/t(2) - y_out%LSSTipMza = y1%LSSTipMza + b0 * t_out - b0 = -(y1%LSSTipMys - y2%LSSTipMys)/t(2) - y_out%LSSTipMys = y1%LSSTipMys + b0 * t_out - b0 = -(y1%LSSTipMzs - y2%LSSTipMzs)/t(2) - y_out%LSSTipMzs = y1%LSSTipMzs + b0 * t_out - b0 = -(y1%YawBrMyn - y2%YawBrMyn)/t(2) - y_out%YawBrMyn = y1%YawBrMyn + b0 * t_out - b0 = -(y1%YawBrMzn - y2%YawBrMzn)/t(2) - y_out%YawBrMzn = y1%YawBrMzn + b0 * t_out - b0 = -(y1%NcIMURAxs - y2%NcIMURAxs)/t(2) - y_out%NcIMURAxs = y1%NcIMURAxs + b0 * t_out - b0 = -(y1%NcIMURAys - y2%NcIMURAys)/t(2) - y_out%NcIMURAys = y1%NcIMURAys + b0 * t_out - b0 = -(y1%NcIMURAzs - y2%NcIMURAzs)/t(2) - y_out%NcIMURAzs = y1%NcIMURAzs + b0 * t_out - b0 = -(y1%RotPwr - y2%RotPwr)/t(2) - y_out%RotPwr = y1%RotPwr + b0 * t_out + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) + b = -(y1%YawRate - y2%YawRate) + y_out%YawRate = y1%YawRate + b * ScaleFactor + b = -(y1%LSS_Spd - y2%LSS_Spd) + y_out%LSS_Spd = y1%LSS_Spd + b * ScaleFactor + b = -(y1%HSS_Spd - y2%HSS_Spd) + y_out%HSS_Spd = y1%HSS_Spd + b * ScaleFactor + b = -(y1%RotSpeed - y2%RotSpeed) + y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor + b = -(y1%TwrAccel - y2%TwrAccel) + y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) + DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) + b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) + y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor + END DO + b = -(y1%YawBrTAxp - y2%YawBrTAxp) + y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor + b = -(y1%YawBrTAyp - y2%YawBrTAyp) + y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) + b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) + y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor + END DO + b = -(y1%LSSTipMxa - y2%LSSTipMxa) + y_out%LSSTipMxa = y1%LSSTipMxa + b * ScaleFactor + b = -(y1%LSSTipMya - y2%LSSTipMya) + y_out%LSSTipMya = y1%LSSTipMya + b * ScaleFactor + b = -(y1%LSSTipMza - y2%LSSTipMza) + y_out%LSSTipMza = y1%LSSTipMza + b * ScaleFactor + b = -(y1%LSSTipMys - y2%LSSTipMys) + y_out%LSSTipMys = y1%LSSTipMys + b * ScaleFactor + b = -(y1%LSSTipMzs - y2%LSSTipMzs) + y_out%LSSTipMzs = y1%LSSTipMzs + b * ScaleFactor + b = -(y1%YawBrMyn - y2%YawBrMyn) + y_out%YawBrMyn = y1%YawBrMyn + b * ScaleFactor + b = -(y1%YawBrMzn - y2%YawBrMzn) + y_out%YawBrMzn = y1%YawBrMzn + b * ScaleFactor + b = -(y1%NcIMURAxs - y2%NcIMURAxs) + y_out%NcIMURAxs = y1%NcIMURAxs + b * ScaleFactor + b = -(y1%NcIMURAys - y2%NcIMURAys) + y_out%NcIMURAys = y1%NcIMURAys + b * ScaleFactor + b = -(y1%NcIMURAzs - y2%NcIMURAzs) + y_out%NcIMURAzs = y1%NcIMURAzs + b * ScaleFactor + b = -(y1%RotPwr - y2%RotPwr) + y_out%RotPwr = y1%RotPwr + b * ScaleFactor END SUBROUTINE ED_Output_ExtrapInterp1 @@ -25115,14 +25032,14 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -25141,9 +25058,11 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i01 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i01), y2%BladeLn2Mesh(i01), y3%BladeLn2Mesh(i01), tin, y_out%BladeLn2Mesh(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25158,8 +25077,8 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i01 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(y1%BladeRootMotion(i01), y2%BladeRootMotion(i01), y3%BladeRootMotion(i01), tin, y_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25170,100 +25089,84 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitch,1))) - ALLOCATE(c1(SIZE(y_out%BlPitch,1))) - b1 = (t(3)**2*(y1%BlPitch - y2%BlPitch) + t(2)**2*(-y1%BlPitch + y3%BlPitch))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlPitch + t(3)*y2%BlPitch - t(2)*y3%BlPitch ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlPitch = y1%BlPitch + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%Yaw - y2%Yaw) + t(2)**2*(-y1%Yaw + y3%Yaw))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Yaw + t(3)*y2%Yaw - t(2)*y3%Yaw ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Yaw = y1%Yaw + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawRate = y1%YawRate + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSS_Spd = y1%LSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%HSS_Spd = y1%HSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RotSpeed = y1%RotSpeed + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TwrAccel = y1%TwrAccel + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawAngle - y2%YawAngle) + t(2)**2*(-y1%YawAngle + y3%YawAngle))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawAngle + t(3)*y2%YawAngle - t(2)*y3%YawAngle ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawAngle = y1%YawAngle + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(y_out%RootMyc,1))) - ALLOCATE(c1(SIZE(y_out%RootMyc,1))) - b1 = (t(3)**2*(y1%RootMyc - y2%RootMyc) + t(2)**2*(-y1%RootMyc + y3%RootMyc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%RootMyc + t(3)*y2%RootMyc - t(2)*y3%RootMyc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMyc = y1%RootMyc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrTAxp = y1%YawBrTAxp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrTAyp = y1%YawBrTAyp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipPxa - y2%LSSTipPxa) + t(2)**2*(-y1%LSSTipPxa + y3%LSSTipPxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipPxa + t(3)*y2%LSSTipPxa - t(2)*y3%LSSTipPxa ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipPxa = y1%LSSTipPxa + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(y_out%RootMxc,1))) - ALLOCATE(c1(SIZE(y_out%RootMxc,1))) - b1 = (t(3)**2*(y1%RootMxc - y2%RootMxc) + t(2)**2*(-y1%RootMxc + y3%RootMxc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%RootMxc + t(3)*y2%RootMxc - t(2)*y3%RootMxc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMxc = y1%RootMxc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMxa = y1%LSSTipMxa + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMya = y1%LSSTipMya + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMza = y1%LSSTipMza + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMys = y1%LSSTipMys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMzs = y1%LSSTipMzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrMyn = y1%YawBrMyn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrMzn = y1%YawBrMzn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAxs = y1%NcIMURAxs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAys = y1%NcIMURAys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAzs = y1%NcIMURAzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RotPwr = y1%RotPwr + b0 * t_out + c0 * t_out**2 + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) + b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor + c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor + y_out%YawRate = y1%YawRate + b + c * t_out + b = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) * scaleFactor + y_out%LSS_Spd = y1%LSS_Spd + b + c * t_out + b = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) * scaleFactor + y_out%HSS_Spd = y1%HSS_Spd + b + c * t_out + b = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))* scaleFactor + c = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) * scaleFactor + y_out%RotSpeed = y1%RotSpeed + b + c * t_out + b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor + c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor + y_out%TwrAccel = y1%TwrAccel + b + c * t_out + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) + DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) + b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor + y_out%RootMyc(i1) = y1%RootMyc(i1) + b + c * t_out + END DO + b = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) * scaleFactor + y_out%YawBrTAxp = y1%YawBrTAxp + b + c * t_out + b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor + y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) + b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor + y_out%RootMxc(i1) = y1%RootMxc(i1) + b + c * t_out + END DO + b = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) * scaleFactor + y_out%LSSTipMxa = y1%LSSTipMxa + b + c * t_out + b = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) * scaleFactor + y_out%LSSTipMya = y1%LSSTipMya + b + c * t_out + b = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) * scaleFactor + y_out%LSSTipMza = y1%LSSTipMza + b + c * t_out + b = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) * scaleFactor + y_out%LSSTipMys = y1%LSSTipMys + b + c * t_out + b = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) * scaleFactor + y_out%LSSTipMzs = y1%LSSTipMzs + b + c * t_out + b = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) * scaleFactor + y_out%YawBrMyn = y1%YawBrMyn + b + c * t_out + b = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) * scaleFactor + y_out%YawBrMzn = y1%YawBrMzn + b + c * t_out + b = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) * scaleFactor + y_out%NcIMURAxs = y1%NcIMURAxs + b + c * t_out + b = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) * scaleFactor + y_out%NcIMURAys = y1%NcIMURAys + b + c * t_out + b = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) * scaleFactor + y_out%NcIMURAzs = y1%NcIMURAzs + b + c * t_out + b = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))* scaleFactor + c = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) * scaleFactor + y_out%RotPwr = y1%RotPwr + b + c * t_out END SUBROUTINE ED_Output_ExtrapInterp2 END MODULE ElastoDyn_Types diff --git a/modules/extptfm/CMakeLists.txt b/modules/extptfm/CMakeLists.txt index 3f7f265e3c..384212ab1d 100644 --- a/modules/extptfm/CMakeLists.txt +++ b/modules/extptfm/CMakeLists.txt @@ -20,6 +20,7 @@ endif() add_library(extptfm_mckflib src/ExtPtfm_MCKF.f90 + src/ExtPtfm_MCKF_IO.f90 src/ExtPtfm_MCKF_Types.f90 ) diff --git a/modules/extptfm/src/ExtPtfm_MCKF.f90 b/modules/extptfm/src/ExtPtfm_MCKF.f90 index 0432e418d3..e5c32f0337 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF.f90 @@ -29,28 +29,25 @@ MODULE ExtPtfm_MCKF USE ExtPtfm_MCKF_Types + USE ExtPtfm_MCKF_Parameters ! ID_*, N_INPUTS, N_OUTPUTS USE NWTC_Library + USE NWTC_LAPACK IMPLICIT NONE PRIVATE - TYPE(ProgDesc), PARAMETER :: ExtPtfm_Ver = ProgDesc( 'ExtPtfm_MCKF', '', '' ) !< module date/version information - - - ! ..... Public Subroutines ................................................................................................... + CHARACTER(len=1), parameter :: XYZ(3)=(/'X','Y','Z'/) + ! ..... Public Subroutines ................................................................................................... PUBLIC :: ExtPtfm_Init ! Initialization routine PUBLIC :: ExtPtfm_End ! Ending routine (includes clean up) - PUBLIC :: ExtPtfm_UpdateStates ! Loose coupling routine for solving for constraint states, integrating ! continuous states, and updating discrete states PUBLIC :: ExtPtfm_CalcOutput ! Routine for computing outputs - PUBLIC :: ExtPtfm_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual PUBLIC :: ExtPtfm_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states PUBLIC :: ExtPtfm_UpdateDiscState ! Tight coupling routine for updating discrete states - PUBLIC :: ExtPtfm_JacobianPInput ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- ! (Xd), and constraint-state (Z) functions all with respect to the inputs (u) PUBLIC :: ExtPtfm_JacobianPContState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- @@ -62,18 +59,38 @@ MODULE ExtPtfm_MCKF PUBLIC :: ExtPtfm_JacobianPConstrState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- ! (Xd), and constraint-state (Z) functions all with respect to the constraint ! states (z) - PUBLIC :: ExtPtfm_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) + + + CONTAINS +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Helper functions for the module + +!> This routine sets the error status and error message for a routine, it's a simplified version of SetErrStat from NWTC_Library +subroutine SetErrStatSimple(ErrStat, ErrMess, RoutineName, LineNumber) + INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None + CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in + INTEGER(IntKi), INTENT(IN), OPTIONAL :: LineNumber ! Line of input file + if (ErrStat /= ErrID_None) then + write(ErrMess,'(A)') TRIM(RoutineName)//':'//TRIM(ErrMess) + if (present(LineNumber)) then + ErrMess = TRIM(ErrMess)//' Line: '//TRIM(Num2LStr(LineNumber))//'.' + endif + end if +end subroutine SetErrStatSimple + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. !! The initial states and initial guess for the input are defined. -SUBROUTINE ExtPtfm_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +SUBROUTINE ExtPtfm_Init( InitInp, u, p, x, xd, z, OtherState, y, m, dt_gluecode, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. - + use ExtPtfm_MCKF_IO, only: ReadPrimaryFile, SetOutParam, ExtPtfm_PrintSum TYPE(ExtPtfm_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(ExtPtfm_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(ExtPtfm_ParameterType), INTENT( OUT) :: p !< Parameters @@ -84,7 +101,7 @@ SUBROUTINE ExtPtfm_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In TYPE(ExtPtfm_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) TYPE(ExtPtfm_MiscVarType), INTENT( OUT) :: m !< Misc variables for optimization (not copied in glue code) - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that + REAL(DbKi), INTENT(INOUT) :: dt_gluecode !< Coupling interval in seconds: the rate that !! (1) ExtPtfm_UpdateStates() is called in loose coupling & !! (2) ExtPtfm_UpdateDiscState() is called in tight coupling. !! Input is the suggested time from the glue code; @@ -93,283 +110,276 @@ SUBROUTINE ExtPtfm_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In TYPE(ExtPtfm_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: I ! Loop counter + TYPE(ExtPtfm_InputFile) :: InputFileData ! Data stored in the module's input file - ! local variables - - INTEGER(IntKi) :: NumOuts ! number of outputs; would probably be in the parameter type - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Init' - - ! Initialize variables + ! Initialize variables ErrStat = ErrID_None ErrMsg = "" - - ! Initialize the NWTC Subroutine Library + ! Initialize the NWTC Subroutine Library call NWTC_Init( ) - - ! Display the module information + ! Display the module information call DispNVD( ExtPtfm_Ver ) + ! Initialize parameters + p%NumOuts = 0 + p%nTot = -1 + p%nCB = -1 - ! set parameters - p%NumOuts = 0 - call ReadPrimaryFile( InitInp%InputFile, p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (errStat >= AbortErrLev) return - - ! Define initial system states here: - x%DummyContState = 0.0_ReKi + call ReadPrimaryFile(InitInp%InputFile, p, InitInp%RootName, InputFileData, ErrStat, ErrMsg); if(Failed()) return + + ! --- Setting Params from Input file data + p%IntMethod = InputFileData%IntMethod + if (InputFileData%DT<0) then + p%EP_DeltaT = dt_gluecode + else + p%EP_DeltaT = InputFileData%DT + endif + ! Setting p%OutParam from OutList + call SetOutParam(InputFileData%OutList, InputFileData%NumOuts, p, ErrStat, ErrMsg); if(Failed()) return + ! Set the constant state matrices A,B,C,D + call SetStateMatrices(p, ErrStat, ErrMsg) + + ! --- Allocate and init continuous states + call AllocAry( x%qm , p%nCB,'CB DOF positions' , ErrStat,ErrMsg); if(Failed()) return + call AllocAry( x%qmdot , p%nCB,'CB DOF velocities', ErrStat,ErrMsg); if(Failed()) return + if (allocated(InputFileData%InitPosList)) then + if (size(InputFileData%InitPosList)/=p%nCB) then + CALL SetErrStat(ErrID_Fatal, 'The number of elements of `InitPosList` ('//trim(Num2LStr(size(InputFileData%InitPosList)))//') does not match the number of CB modes: '//trim(Num2LStr(p%nCB)), ErrStat, ErrMsg, 'ExtPtfm_Init'); + return + endif + do I=1,p%nCB; + x%qm(I)=InputFileData%InitPosList(I); + end do + else + do I=1,p%nCB; x%qm (I)=0; end do + endif + if (allocated(InputFileData%InitVelList)) then + if (size(InputFileData%InitVelList)/=p%nCB) then + CALL SetErrStat(ErrID_Fatal, 'The number of elements of `InitVelList` ('//trim(Num2LStr(size(InputFileData%InitVelList)))//') does not match the number of CB modes: '//trim(Num2LStr(p%nCB)), ErrStat, ErrMsg, 'ExtPtfm_Init'); + return + endif + do I=1,p%nCB; + x%qmdot(I)=InputFileData%InitVelList(I); + enddo + else + do I=1,p%nCB; x%qmdot(I)=0; end do + endif + + ! Other states xd%DummyDiscState = 0.0_ReKi z%DummyConstrState = 0.0_ReKi - OtherState%DummyOtherState = 0.0_ReKi - - ! initialize optimization variables: - m%Indx = 1 + ! allocate OtherState%xdot if using multi-step method; initialize n + if ( ( p%IntMethod .eq. 2) .OR. ( p%IntMethod .eq. 3)) THEN + allocate( OtherState%xdot(4), STAT=ErrStat ) + ErrMsg='Error allocating OtherState%xdot' + if(Failed()) return + endif + + ! Initialize Misc Variables: + !m%EquilStart = InputFileData%EquilStart + m%EquilStart = .False. ! Feature not yet implemented + + m%Indx = 1 ! used to optimize interpolation of loads in time + call AllocAry( m%F_at_t, p%nTot,'Loads at t', ErrStat,ErrMsg); if(Failed()) return + do I=1,p%nTot; m%F_at_t(I)=0; end do + call AllocAry( m%xFlat, 2*p%nCB,'xFlat', ErrStat,ErrMsg); if(Failed()) return + do I=1,2*p%nCB; m%xFlat(I)=0; end do + do I=1,N_INPUTS; m%uFlat(I)=0; end do - ! Define initial guess (set up mesh first) for the system inputs here: - call Init_meshes(u, y, ErrStat, ErrMsg) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Define system output initializations (set up mesh) here: - call AllocAry( y%WriteOutput, p%NumOuts,'WriteOutput', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! set return error status based on local (concatenate errors) - call AllocAry(InitOut%WriteOutputHdr,p%NumOuts,'WriteOutputHdr',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%WriteOutputUnt,p%NumOuts,'WriteOutputUnt',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return - + ! Define initial guess (set up mesh first) for the system inputs here: + call Init_meshes(u, y, InitInp, ErrStat, ErrMsg); if(Failed()) return + + ! --- Outputs + CALL AllocAry( m%AllOuts, ID_QStart+3*p%nCBFull-1, "ExtPtfm AllOut", ErrStat,ErrMsg ); if(Failed()) return + m%AllOuts(1:ID_QStart+3*p%nCBFull-1) = 0.0 + call AllocAry( y%WriteOutput, p%NumOuts,'WriteOutput', ErrStat,ErrMsg); if(Failed()) return + call AllocAry(InitOut%WriteOutputHdr,p%NumOuts,'WriteOutputHdr',ErrStat,ErrMsg); if(Failed()) return + call AllocAry(InitOut%WriteOutputUnt,p%NumOuts,'WriteOutputUnt',ErrStat,ErrMsg); if(Failed()) return + y%WriteOutput(1:p%NumOuts) = 0.0 + InitOut%WriteOutputHdr(1:p%NumOuts) = p%OutParam(1:p%NumOuts)%Name + InitOut%WriteOutputUnt(1:p%NumOuts) = p%OutParam(1:p%NumOuts)%Units InitOut%Ver = ExtPtfm_Ver if (InitInp%Linearize) then - - ! If the module does not implement the four Jacobian routines at the end of this template, or the module cannot - ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true. - - CALL SetErrStat( ErrID_Fatal, 'ExtPtfm_MCKF cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName) - - ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here: - ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u - ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u - + ! TODO The linearization features are in place but waiting for glue-code changes, and testing. + CALL SetErrStat( ErrID_Fatal, 'ExtPtfm_MCKF linearization analysis is currently not supported by the glue code.', ErrStat, ErrMsg, 'ExtPtfm_Init'); + if(Failed())return + !Appropriate Jacobian row/column names and rotating-frame flags here: + CALL AllocAry(InitOut%LinNames_y, 6+p%NumOuts , 'LinNames_y', ErrStat, ErrMsg); if(Failed()) return + CALL AllocAry(InitOut%RotFrame_y, 6+p%NumOuts , 'RotFrame_y', ErrStat, ErrMsg); if(Failed()) return + CALL AllocAry(InitOut%LinNames_x, 2*p%nCB , 'LinNames_x', ErrStat, ErrMsg); if(Failed()) return + CALL AllocAry(InitOut%RotFrame_x, 2*p%nCB , 'RotFrame_x', ErrStat, ErrMsg); if(Failed()) return + CALL AllocAry(InitOut%LinNames_u, N_INPUTS , 'LinNames_u', ErrStat, ErrMsg); if(Failed()) return + CALL AllocAry(InitOut%RotFrame_u, N_INPUTS , 'RotFrame_u', ErrStat, ErrMsg); if(Failed()) return + CALL AllocAry(InitOut%IsLoad_u , N_INPUTS , 'IsLoad_u' , ErrStat, ErrMsg); if(Failed()) return + ! LinNames_y + do I=1,3; + InitOut%LinNames_y(I) = 'Interface node '//XYZ(I)//' force, N' + InitOut%LinNames_y(I+3) = 'Interface node '//XYZ(I)//' moment, Nm' + enddo + do i=1,p%NumOuts + InitOut%LinNames_y(N_OUTPUTS+i) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + end do + ! LinNames_u + do I=1,3; + InitOut%LinNames_u(I+ 0) = 'Interface node '//XYZ(I)//' translation displacement, m' + InitOut%LinNames_u(I+ 3) = 'Interface node '//XYZ(I)//' rotation, rad' + InitOut%LinNames_u(I+ 6) = 'Interface node '//XYZ(I)//' translation velocity, m/s' + InitOut%LinNames_u(I+ 9) = 'Interface node '//XYZ(I)//' rotation velocity, rad/s' + InitOut%LinNames_u(I+12) = 'Interface node '//XYZ(I)//' translation acceleration, m/s^2' + InitOut%LinNames_u(I+15) = 'Interface node '//XYZ(I)//' rotation acceleration, rad/s^2' + enddo + ! LinNames_x + do I=1,p%nCB; + InitOut%LinNames_x(I) = 'Mode '//trim(Num2LStr(p%ActiveCBDOF(I)))//' displacement, -'; + InitOut%LinNames_x(I+p%nCB) = 'Mode '//trim(Num2LStr(p%ActiveCBDOF(I)))//' velocity, -'; + enddo + ! + InitOut%RotFrame_x = .false. ! note that meshes are in the global, not rotating frame + InitOut%RotFrame_y = .false. ! note that meshes are in the global, not rotating frame + InitOut%RotFrame_u = .false. ! note that meshes are in the global, not rotating frame + InitOut%IsLoad_u = .false. ! the inputs are not loads but kinematics end if - - + + ! --- Summary file + if (InputFileData%SumPrint) then + call ExtPtfm_PrintSum(x, p, m, InitInp%RootName, ErrStat, ErrMsg); if(Failed()) return + endif + +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_Init') + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ExtPtfm_Init -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadPrimaryFile( InputFile, p, ErrStat, ErrMsg ) -!.................................................................................................................................. - IMPLICIT NONE - ! Passed variables - CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetStateMatrices( p, ErrStat, ErrMsg) +!.................................................................................................................................. TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< All the parameter matrices stored in this input file INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - - - ! Local variables: - REAL(ReKi) :: TmpAry(7) ! temporary array for reading row from file - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - LOGICAL :: Echo ! Determines if an echo file should be written - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - CHARACTER(1024) :: FTitle ! "File Title": the 1st line of the input file, which contains a description of its contents - CHARACTER(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - CHARACTER(*), PARAMETER :: RoutineName = 'ReadPrimaryFile' - - - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - !CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - ! Get an available unit number for the file. - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the Primary input file. - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - !-------------------------- HEADER --------------------------------------------- - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: External Platform MCKF Matrices (line 1)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - !---------------------- MASS MATRIX -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Mass Matrix', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !Read Mass - DO I =1,6 - CALL ReadAry( UnIn, InputFile, p%PtfmAM(I,:), 6, 'PtfmAM', 'Mass Matrix Terms', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDDO - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - - !---------------------- DAMPING MATRIX -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Damping Matrix', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !Read Damping - DO I =1,6 - CALL ReadAry( UnIn, InputFile, p%Damp(I,:), 6, 'Damp', 'Damping Matrix Terms', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDDO - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - - !---------------------- STIFFNESS MATRIX -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Stiffness Matrix', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !Read Stiffness - DO I =1,6 - CALL ReadAry( UnIn, InputFile, p%Stff(I,:), 6, 'Stff', 'Stiffness Matrix Terms', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDDO - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - - !---------------------- LOAD time-history -------------------------------------- - p%nPtfmFt = 0 - CALL ReadCom( UnIn, InputFile, 'Section Header: Loads time-history', ErrStat2, ErrMsg2, UnEc ) - CALL ReadCom( UnIn, InputFile, 'Loads time-history table channel names', ErrStat2, ErrMsg2, UnEc ) - CALL ReadCom( UnIn, InputFile, 'Loads time-history table channel units', ErrStat2, ErrMsg2, UnEc ) - if (ErrStat2 < AbortErrLev) then - ! let's figure out how many rows of data are in the time-history table: - read( UnIn, *, IOSTAT=ErrStat2 ) TmpAry - do while (ErrStat2==0) - p%nPtfmFt = p%nPtfmFt + 1 - read( UnIn, *, IOSTAT=ErrStat2 ) TmpAry - end do - end if - - call allocAry( p%PtfmFt, max(1,p%nPtfmFt), 6, 'p%PtfmFt', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call allocAry( p%PtfmFt_t, max(1,p%nPtfmFt), 'p%PtfmFt_t', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - if (p%nPtfmFt == 0) then - p%PtfmFt = 0.0_ReKi - p%PtfmFt_t = 0.0_ReKi - p%nPtfmFt = 1 - else - rewind(UnIn) - - do i=1,25 ! skip the first 25 rows of the file until we get to the data for the time-history table - read(UnIn,*,IOSTAT=ErrStat2) line - end do - - do i=1,p%nPtfmFt - - call ReadAry( UnIn, InputFile, TmpAry, 7, 'PtfmFt', 'PtfmFt time-history', ErrStat2, ErrMsg2, UnEc ) - - p%PtfmFt_t(i) = TmpAry(1) - p%PtfmFt(i,:) = TmpAry(2:7) - - end do - - end if - - - !---------------------- END OF FILE ----------------------------------------- - - call cleanup() - RETURN - - + ! Local variables: + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: nX ! Number of states + INTEGER(IntKi) :: nU ! Number of inputs + INTEGER(IntKi) :: nY ! Number of ouputs + INTEGER(IntKi) :: n1 ! Number of interface DOF + INTEGER(IntKi) :: n2 ! Number of CB DOF + real(ReKi), dimension(:,:), allocatable :: I22 + ! Init + nX = 2*p%nCB + nU = 3*6 + nY = 6 + n1 = 6 + n2 = p%nCB + if (allocated(p%AMat)) deallocate(p%AMat) + if (allocated(p%BMat)) deallocate(p%BMat) + if (allocated(p%CMat)) deallocate(p%CMat) + if (allocated(p%DMat)) deallocate(p%DMat) + if (allocated(p%M11)) deallocate(p%M11) + if (allocated(p%M12)) deallocate(p%M12) + if (allocated(p%M22)) deallocate(p%M22) + if (allocated(p%M21)) deallocate(p%M21) + if (allocated(p%C11)) deallocate(p%C11) + if (allocated(p%C12)) deallocate(p%C12) + if (allocated(p%C22)) deallocate(p%C22) + if (allocated(p%C21)) deallocate(p%C21) + if (allocated(p%K11)) deallocate(p%C11) + if (allocated(p%K22)) deallocate(p%C22) + ! Allocation + call allocAry(p%AMat, nX, nX, 'p%AMat', ErrStat, ErrMsg); if(Failed()) return ; p%AMat(1:nX,1:nX) =0 + call allocAry(p%BMat, nX, nU, 'p%BMat', ErrStat, ErrMsg); if(Failed()) return ; p%BMat(1:nX,1:nU) =0 + call allocAry(p%FX , nX, 'p%FX' , ErrStat, ErrMsg); if(Failed()) return ; p%Fx (1:nX) =0 + call allocAry(p%CMat, nY, nX, 'p%CMat', ErrStat, ErrMsg); if(Failed()) return ; p%CMat(1:nY,1:nX) =0 + call allocAry(p%DMat, nY, nU, 'p%DMat', ErrStat, ErrMsg); if(Failed()) return ; p%DMat(1:nY,1:nU) =0 + call allocAry(p%FY , nY, 'p%FY' , ErrStat, ErrMsg); if(Failed()) return ; p%FY (1:nY) =0 + call allocAry(p%M11 , n1, n1, 'p%M11' , ErrStat, ErrMsg); if(Failed()) return ; p%M11 (1:n1,1:n1) =0 + call allocAry(p%K11 , n1, n1, 'p%K11' , ErrStat, ErrMsg); if(Failed()) return ; p%K11 (1:n1,1:n1) =0 + call allocAry(p%C11 , n1, n1, 'p%C11' , ErrStat, ErrMsg); if(Failed()) return ; p%C11 (1:n1,1:n1) =0 + call allocAry(p%M22 , n2, n2, 'p%M22' , ErrStat, ErrMsg); if(Failed()) return ; p%M22 (1:n2,1:n2) =0 + call allocAry(p%K22 , n2, n2, 'p%K22' , ErrStat, ErrMsg); if(Failed()) return ; p%K22 (1:n2,1:n2) =0 + call allocAry(p%C22 , n2, n2, 'p%C22' , ErrStat, ErrMsg); if(Failed()) return ; p%C22 (1:n2,1:n2) =0 + call allocAry(p%M12 , n1, n2, 'p%M12' , ErrStat, ErrMsg); if(Failed()) return ; p%M12 (1:n1,1:n2) =0 + call allocAry(p%C12 , n1, n2, 'p%C12' , ErrStat, ErrMsg); if(Failed()) return ; p%C12 (1:n1,1:n2) =0 + call allocAry(p%M21 , n2, n1, 'p%M21' , ErrStat, ErrMsg); if(Failed()) return ; p%M21 (1:n2,1:n1) =0 + call allocAry(p%C21 , n2, n1, 'p%C21' , ErrStat, ErrMsg); if(Failed()) return ; p%C21 (1:n2,1:n1) =0 + call allocAry( I22 , n2, n2, ' I22' , ErrStat, ErrMsg); if(Failed()) return ; I22 (1:n2,1:n2) =0 + do I=1,n2 ; I22(I,I)=1; enddo ! Identity matrix + ! Submatrices + p%M11(1:n1,1:n1) = p%Mass(1:n1 ,1:n1 ) + p%C11(1:n1,1:n1) = p%Damp(1:n1 ,1:n1 ) + p%K11(1:n1,1:n1) = p%Stff(1:n1 ,1:n1 ) + p%M12(1:n1,1:n2) = p%Mass(1:n1 ,n1+1:n1+n2) + p%C12(1:n1,1:n2) = p%Damp(1:n1 ,n1+1:n1+n2) + p%M21(1:n2,1:n1) = p%Mass(n1+1:n1+n2,1:n1 ) + p%C21(1:n2,1:n1) = p%Damp(n1+1:n1+n2,1:n1 ) + p%M22(1:n2,1:n2) = p%Mass(n1+1:n1+n2,n1+1:n1+n2) + p%C22(1:n2,1:n2) = p%Damp(n1+1:n1+n2,n1+1:n1+n2) + p%K22(1:n2,1:n2) = p%Stff(n1+1:n1+n2,n1+1:n1+n2) + ! A matrix + p%AMat(1:n2 ,n2+1:nX) = I22 (1:n2,1:n2) + p%AMat(n2+1:nX,1:n2 ) = -p%K22(1:n2,1:n2) + p%AMat(n2+1:nX,n2+1:nX) = -p%C22(1:n2,1:n2) + ! B matrix + p%BMat(n2+1:nX,7 :12 ) = -p%C21(1:n2,1:6) + p%BMat(n2+1:nX,13:18 ) = -p%M21(1:n2,1:6) + ! C matrix + p%CMat(1:nY,1:n2 ) = matmul(p%M12,p%K22) + p%CMat(1:nY,n2+1:nX) = matmul(p%M12,p%C22) - p%C12 + ! D matrix + p%DMat(1:nY,1:6 ) = -p%K11 + p%DMat(1:nY,7:12 ) = -p%C11 + matmul(p%M12,p%C21) + p%DMat(1:nY,13:18 ) = -p%M11 + matmul(p%M12,p%M21) CONTAINS - !............................................................................................................................... - SUBROUTINE cleanup() - - CLOSE( UnIn ) - - END SUBROUTINE cleanup - !............................................................................................................................... -END SUBROUTINE ReadPrimaryFile + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_SetStateMatrices') + Failed = ErrStat >= AbortErrLev + end function Failed +END SUBROUTINE SetStateMatrices !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_meshes(u, y, ErrStat, ErrMsg) - +SUBROUTINE Init_meshes(u, y, InitInp, ErrStat, ErrMsg) TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u !< System inputs TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(ExtPtfm_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'Init_meshes' - - - ErrStat = ErrID_None - ErrMSg = "" - - ! Create the input and output meshes associated with platform loads + ! Create the input and output meshes associated with platform loads CALL MeshCreate( BlankMesh = u%PtfmMesh , & IOS = COMPONENT_INPUT , & Nnodes = 1 , & - ErrStat = ErrStat2 , & - ErrMess = ErrMsg2 , & + ErrStat = ErrStat , & + ErrMess = ErrMsg , & TranslationDisp = .TRUE. , & Orientation = .TRUE. , & TranslationVel = .TRUE. , & RotationVel = .TRUE. , & TranslationAcc = .TRUE. , & RotationAcc = .TRUE.) - - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) return + if(Failed()) return - ! Create the node on the mesh - CALL MeshPositionNode (u%PtfmMesh, 1, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Create the mesh element - CALL MeshConstructElement ( u%PtfmMesh, ELEMENT_POINT, ErrStat2, ErrMsg2, 1 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL MeshCommit ( u%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) return - - - ! the output mesh is a sibling of the input: + ! Create the node on the mesh, the node is located at the PlatformRefzt, to match ElastoDyn + CALL MeshPositionNode (u%PtfmMesh, 1, (/0.0_ReKi, 0.0_ReKi, InitInp%PtfmRefzt/), ErrStat, ErrMsg ); if(Failed()) return + ! Create the mesh element + CALL MeshConstructElement ( u%PtfmMesh, ELEMENT_POINT, ErrStat, ErrMsg, 1 ); if(Failed()) return + CALL MeshCommit ( u%PtfmMesh, ErrStat, ErrMsg ); if(Failed()) return + ! the output mesh is a sibling of the input: CALL MeshCopy( SrcMesh=u%PtfmMesh, DestMesh=y%PtfmMesh, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, & - ErrStat=ErrStat2, ErrMess=ErrMsg2, Force=.TRUE., Moment=.TRUE. ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - + ErrStat=ErrStat, ErrMess=ErrMsg, Force=.TRUE., Moment=.TRUE. ) + if(Failed()) return +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'Init_meshes') + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE Init_meshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE ExtPtfm_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u !< System inputs TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< Parameters TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states @@ -380,60 +390,257 @@ SUBROUTINE ExtPtfm_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Place any last minute operations or calculations here: + ! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation): + ! Destroy the input data: + call ExtPtfm_DestroyInput( u, ErrStat, ErrMsg ); if(Failed()) return + ! Destroy the parameter data: + call ExtPtfm_DestroyParam( p, ErrStat, ErrMsg ); if(Failed()) return + ! Destroy the state data: + call ExtPtfm_DestroyContState( x, ErrStat,ErrMsg); if(Failed()) return + call ExtPtfm_DestroyDiscState( xd, ErrStat,ErrMsg); if(Failed()) return + call ExtPtfm_DestroyConstrState( z, ErrStat,ErrMsg); if(Failed()) return + call ExtPtfm_DestroyOtherState( OtherState, ErrStat,ErrMsg); if(Failed()) return + ! Destroy the output data: + call ExtPtfm_DestroyOutput( y, ErrStat, ErrMsg ); if(Failed()) return + ! Destroy the misc data: + call ExtPtfm_DestroyMisc( m, ErrStat, ErrMsg ); if(Failed()) return +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_End') + Failed = ErrStat >= AbortErrLev + end function Failed +END SUBROUTINE ExtPtfm_End - ! local variables - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_End' - - ! Initialize ErrStat +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Adams-Bashforth Method (RK4) for numerically integrating ordinary differential +!! equations: +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! x(t+dt) = x(t) + (dt / 24.) * ( 55.*f(t,x) - 59.*f(t-dt,x) + 37.*f(t-2.*dt,x) - 9.*f(t-3.*dt,x) ) +!! See, e.g., +!! http://en.wikipedia.org/wiki/Linear_multistep_method +!! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. +SUBROUTINE ExtPtfm_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u(:) !< Inputs at t + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! local variables + TYPE(ExtPtfm_ContinuousStateType) :: xdot ! Continuous state derivs at t + TYPE(ExtPtfm_InputType) :: u_interp + ! Initialize ErrStat ErrStat = ErrID_None - ErrMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation): - - - ! Destroy the input data: - - call ExtPtfm_DestroyInput( u, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! Destroy the parameter data: - - call ExtPtfm_DestroyParam( p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Destroy the state data: - - call ExtPtfm_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ExtPtfm_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ExtPtfm_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ExtPtfm_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! Destroy the output data: - - call ExtPtfm_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! Destroy the misc data: + ErrMsg = "" + + ! need xdot at t + CALL ExtPtfm_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg ) ! we need to allocate input arrays/meshes before calling ExtrapInterp... + CALL ExtPtfm_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat, ErrMsg) + CALL ExtPtfm_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) ! initializes xdot + CALL ExtPtfm_DestroyInput( u_interp, ErrStat, ErrMsg) ! we don't need this local copy anymore + if (n .le. 2) then + OtherState%n = n + CALL ExtPtfm_CopyContState(xdot, OtherState%xdot(3-n), MESH_UPDATECOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_RK4(t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + else + if (OtherState%n .lt. n) then + OtherState%n = n + CALL ExtPtfm_CopyContState(OtherState%xdot(3), OtherState%xdot(4), MESH_UPDATECOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_CopyContState(OtherState%xdot(2), OtherState%xdot(3), MESH_UPDATECOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_CopyContState(OtherState%xdot(1), OtherState%xdot(2), MESH_UPDATECOPY, ErrStat, ErrMsg ) + elseif (OtherState%n .gt. n) then + ErrStat = ErrID_Fatal + ErrMsg = ' Backing up in time is not supported with a multistep method ' + RETURN + endif + CALL ExtPtfm_CopyContState( xdot, OtherState%xdot ( 1 ), MESH_UPDATECOPY, ErrStat, ErrMsg ) + !OtherState%xdot ( 1 ) = xdot ! make sure this is most up to date + x%qm = x%qm + (p%EP_DeltaT / 24.) * ( 55.*OtherState%xdot(1)%qm - 59.*OtherState%xdot(2)%qm + 37.*OtherState%xdot(3)%qm & + - 9. * OtherState%xdot(4)%qm ) + x%qmdot = x%qmdot + (p%EP_DeltaT / 24.) * ( 55.*OtherState%xdot(1)%qmdot - 59.*OtherState%xdot(2)%qmdot & + + 37.*OtherState%xdot(3)%qmdot - 9.*OtherState%xdot(4)%qmdot ) + endif + CALL ExtPtfm_DestroyContState(xdot, ErrStat, ErrMsg) + CALL ExtPtfm_DestroyInput(u_interp, ErrStat, ErrMsg) + +END SUBROUTINE ExtPtfm_AB4 +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Adams-Bashforth-Moulton Method (RK4) for numerically integrating ordinary +!! differential equations: +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! Adams-Bashforth Predictor: +!! x^p(t+dt) = x(t) + (dt / 24.) * ( 55.*f(t,x) - 59.*f(t-dt,x) + 37.*f(t-2.*dt,x) - 9.*f(t-3.*dt,x) ) +!! Adams-Moulton Corrector: +!! x(t+dt) = x(t) + (dt / 24.) * ( 9.*f(t+dt,x^p) + 19.*f(t,x) - 5.*f(t-dt,x) + 1.*f(t-2.*dt,x) ) +!! See, e.g., +!! http://en.wikipedia.org/wiki/Linear_multistep_method +!! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. +SUBROUTINE ExtPtfm_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u(:) !< Inputs at t + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output ! TODO TODO TODO IN + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! local variables + TYPE(ExtPtfm_InputType) :: u_interp ! Continuous states at t + TYPE(ExtPtfm_ContinuousStateType) :: x_pred ! Continuous states at t + TYPE(ExtPtfm_ContinuousStateType) :: xdot_pred ! Continuous states at t + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + CALL ExtPtfm_CopyContState(x, x_pred, MESH_NEWCOPY, ErrStat, ErrMsg) !initialize x_pred + CALL ExtPtfm_AB4( t, n, u, utimes, p, x_pred, xd, z, OtherState, m, ErrStat, ErrMsg ) + if (n .gt. 2) then + CALL ExtPtfm_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg) ! make copy so that arrays/meshes get initialized/allocated for ExtrapInterp + CALL ExtPtfm_Input_ExtrapInterp(u, utimes, u_interp, t + p%EP_DeltaT, ErrStat, ErrMsg) + CALL ExtPtfm_CalcContStateDeriv(t + p%EP_DeltaT, u_interp, p, x_pred, xd, z, OtherState, m, xdot_pred, ErrStat, ErrMsg ) ! initializes xdot_pred + CALL ExtPtfm_DestroyInput( u_interp, ErrStat, ErrMsg) ! local copy no longer needed + + x%qm = x%qm + (p%EP_DeltaT / 24.) * ( 9. * xdot_pred%qm + 19. * OtherState%xdot(1)%qm - 5. * OtherState%xdot(2)%qm & + + 1. * OtherState%xdot(3)%qm ) + + x%qmdot = x%qmdot + (p%EP_DeltaT / 24.) * ( 9. * xdot_pred%qmdot + 19. * OtherState%xdot(1)%qmdot - 5. * OtherState%xdot(2)%qmdot & + + 1. * OtherState%xdot(3)%qmdot ) + CALL ExtPtfm_DestroyContState( xdot_pred, ErrStat, ErrMsg) ! local copy no longer needed + else + x%qm = x_pred%qm + x%qmdot = x_pred%qmdot + endif + CALL ExtPtfm_DestroyContState( x_pred, ErrStat, ErrMsg) ! local copy no longer needed +END SUBROUTINE ExtPtfm_ABM4 - call ExtPtfm_DestroyMisc( m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for numerically integrating ordinary differential equations: +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! Define constants k1, k2, k3, and k4 as +!! k1 = dt * f(t , x_t ) +!! k2 = dt * f(t + dt/2 , x_t + k1/2 ) +!! k3 = dt * f(t + dt/2 , x_t + k2/2 ), and +!! k4 = dt * f(t + dt , x_t + k3 ). +!! Then the continuous states at t = t + dt are +!! x_(t+dt) = x_t + k1/6 + k2/3 + k3/3 + k4/6 + O(dt^5) +!! For details, see: +!! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for +!! Runge-Kutta." sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Cambridge University Press, pp. 704-716, 1992. +SUBROUTINE ExtPtfm_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u(:) !< Inputs at t + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! local variables + TYPE(ExtPtfm_ContinuousStateType) :: xdot ! time derivatives of continuous states + TYPE(ExtPtfm_ContinuousStateType) :: k1 ! RK4 constant; see above + TYPE(ExtPtfm_ContinuousStateType) :: k2 ! RK4 constant; see above + TYPE(ExtPtfm_ContinuousStateType) :: k3 ! RK4 constant; see above + TYPE(ExtPtfm_ContinuousStateType) :: k4 ! RK4 constant; see above + TYPE(ExtPtfm_ContinuousStateType) :: x_tmp ! Holds temporary modification to x + TYPE(ExtPtfm_InputType) :: u_interp ! interpolated value of inputs + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Initialize interim vars + !bjj: the state type contains allocatable arrays, so we must first allocate space: + CALL ExtPtfm_CopyContState( x, k1, MESH_NEWCOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_CopyContState( x, k2, MESH_NEWCOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_CopyContState( x, k3, MESH_NEWCOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_CopyContState( x, k4, MESH_NEWCOPY, ErrStat, ErrMsg ) + CALL ExtPtfm_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat, ErrMsg ) + + ! interpolate u to find u_interp = u(t) + CALL ExtPtfm_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg ) ! we need to allocate input arrays/meshes before calling ExtrapInterp... + CALL ExtPtfm_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat, ErrMsg ) + + ! find xdot at t + CALL ExtPtfm_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) !initializes xdot + + k1%qm = p%EP_DeltaT * xdot%qm + k1%qmdot = p%EP_DeltaT * xdot%qmdot + x_tmp%qm = x%qm + 0.5 * k1%qm + x_tmp%qmdot = x%qmdot + 0.5 * k1%qmdot + + ! interpolate u to find u_interp = u(t + dt/2) + CALL ExtPtfm_Input_ExtrapInterp(u, utimes, u_interp, t+0.5*p%EP_DeltaT, ErrStat, ErrMsg) + + ! find xdot at t + dt/2 + CALL ExtPtfm_CalcContStateDeriv( t + 0.5*p%EP_DeltaT, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) + + k2%qm = p%EP_DeltaT * xdot%qm + k2%qmdot = p%EP_DeltaT * xdot%qmdot + x_tmp%qm = x%qm + 0.5 * k2%qm + x_tmp%qmdot = x%qmdot + 0.5 * k2%qmdot + + ! find xdot at t + dt/2 + CALL ExtPtfm_CalcContStateDeriv( t + 0.5*p%EP_DeltaT, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) + + k3%qm = p%EP_DeltaT * xdot%qm + k3%qmdot = p%EP_DeltaT * xdot%qmdot + x_tmp%qm = x%qm + k3%qm + x_tmp%qmdot = x%qmdot + k3%qmdot + + ! interpolate u to find u_interp = u(t + dt) + CALL ExtPtfm_Input_ExtrapInterp(u, utimes, u_interp, t + p%EP_DeltaT, ErrStat, ErrMsg) + + ! find xdot at t + dt + CALL ExtPtfm_CalcContStateDeriv( t + p%EP_DeltaT, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) + + k4%qm = p%EP_DeltaT * xdot%qm + k4%qmdot = p%EP_DeltaT * xdot%qmdot + x%qm = x%qm + ( k1%qm + 2. * k2%qm + 2. * k3%qm + k4%qm ) / 6. + x%qmdot = x%qmdot + ( k1%qmdot + 2. * k2%qmdot + 2. * k3%qmdot + k4%qmdot ) / 6. + CALL ExitThisRoutine() +CONTAINS + !............................................................................................................................... + SUBROUTINE ExitThisRoutine() + ! This subroutine destroys all the local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CALL ExtPtfm_DestroyContState( xdot, ErrStat3, ErrMsg3 ) + CALL ExtPtfm_DestroyContState( k1, ErrStat3, ErrMsg3 ) + CALL ExtPtfm_DestroyContState( k2, ErrStat3, ErrMsg3 ) + CALL ExtPtfm_DestroyContState( k3, ErrStat3, ErrMsg3 ) + CALL ExtPtfm_DestroyContState( k4, ErrStat3, ErrMsg3 ) + CALL ExtPtfm_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) + CALL ExtPtfm_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) + END SUBROUTINE ExitThisRoutine + +END SUBROUTINE ExtPtfm_RK4 -END SUBROUTINE ExtPtfm_End !---------------------------------------------------------------------------------------------------------------------------------- !> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other !! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. SUBROUTINE ExtPtfm_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval TYPE(ExtPtfm_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output from this routine only @@ -451,26 +658,23 @@ SUBROUTINE ExtPtfm_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherSta TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables - !INTEGER(IntKi) :: ErrStat2 ! local error status - !CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - !CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UpdateStates' - - - ! Initialize variables - + ! Initialize variables ErrStat = ErrID_None ! no error has occurred ErrMsg = "" - - - + if ( p%nCB == 0) return ! no modes = no states + if (p%IntMethod .eq. 1) then + call ExtPtfm_RK4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + elseif (p%IntMethod .eq. 2) then + call ExtPtfm_AB4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + elseif (p%IntMethod .eq. 3) then + call ExtPtfm_ABM4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + else + call SetErrStat(ErrID_Fatal,'Invalid time integration method:'//Num2LStr(p%IntMethod),ErrStat,ErrMsg,'ExtPtfm_UpdateState') + end IF END SUBROUTINE ExtPtfm_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> This is a routine for computing outputs, used in both loose and tight coupling. SUBROUTINE ExtPtfm_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -483,59 +687,74 @@ SUBROUTINE ExtPtfm_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Err !! nectivity information does not have to be recalculated) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - INTEGER(IntKi) :: I,J !< Generic counters - INTEGER(IntKi) :: ErrStat2 !< Temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 !< Temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName='ExtPtfm_CalcOutput' - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! translate inputs on mesh to arrays for computations: - m%q(1:3) = u%PtfmMesh%TranslationDisp(:,1) - m%q(4:6) = GetSmllRotAngs ( u%PtfmMesh%Orientation(:,:,1), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - m%qdot(1:3) = u%PtfmMesh%TranslationVel(:,1) - m%qdot(4:6) = u%PtfmMesh%RotationVel(:,1) - - m%qdotdot(1:3) = u%PtfmMesh%TranslationAcc(:,1) - m%qdotdot(4:6) = u%PtfmMesh%RotationAcc(:,1) - - ! compute the platform force (without added mass): - ! get interpolated (in time) loads, m%PtfmFt - call InterpStpMat( REAL(t,ReKi), p%PtfmFt_t, p%PtfmFt, m%Indx, p%nPtfmFt, m%PtfmFt ) ! interpolate this based on the time history read in - - ! add the loads from damping and stiffness - DO J = 1,6 - DO I = 1,6 - m%PtfmFt(I) = m%PtfmFt(I) - p%Damp(I,J) * m%qdot(J) - p%Stff(I,J) * m%q(J) - ENDDO - ENDDO - - ! Now calculate the loads from the added mass matrix - m%F_PtfmAM = -matmul(p%PtfmAM, m%qdotdot) - - - ! Update the Mesh with sum of these loads - DO I=1,3 - y%PtfmMesh%Force(I,1) = m%F_PtfmAM(I) + m%PtfmFt(I) - y%PtfmMesh%Moment(I,1) = m%F_PtfmAM(I+3) + m%PtfmFt(I+3) - ENDDO - - - - !y%WriteOutput(1) = y%PtfmMesh%Force(1,1) - !y%WriteOutput(2) = y%PtfmMesh%Moment(1,1) - ! - + ! Local variables + INTEGER(IntKi) :: I !< Generic counters + real(ReKi), dimension(6) :: Fc !< Output coupling force + ! Compute the loads `fr1 fr2` at t (fr1 without added mass) by time interpolation of the inputs loads p%Forces + call InterpStpMat(REAL(t,ReKi), p%times, p%Forces, m%Indx, p%nTimeSteps, m%F_at_t) + + ! --- Flatening vectors and using linear state formulation y=Cx+Du+Fy + ! u flat (x1, \dot{x1}, \ddot{x1}) + m%uFlat(1:3) = u%PtfmMesh%TranslationDisp(:,1) + m%uFlat(4:6) = GetSmllRotAngs(u%PtfmMesh%Orientation(:,:,1), ErrStat, ErrMsg); CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_CalcOutput') + m%uFlat(7:9 ) = u%PtfmMesh%TranslationVel(:,1) + m%uFlat(10:12) = u%PtfmMesh%RotationVel (:,1) + m%uFlat(13:15) = u%PtfmMesh%TranslationAcc(:,1) + m%uFlat(16:18) = u%PtfmMesh%RotationAcc (:,1) + + !--- Computing output: y = Cx + Du + Fy + ! + if (p%nCB>0) then + ! x flat + m%xFlat( 1:p%nCB ) = x%qm (1:p%nCB) + m%xFlat(p%nCB+1:2*p%nCB) = x%qmdot(1:p%nCB) + + ! >>> MATMUL implementation + !Fc = matmul(p%CMat, m%xFlat) + matmul(p%DMat, m%uFlat) + m%F_at_t(1:6) - matmul(p%M12, m%F_at_t(6+1:6+p%nCB)) + + ! >>> LAPACK implementation + Fc(1:6) = m%F_at_t(1:6) ! Fc = F1r + ... + ! GEMV(TRS, M , N , alpha , A , LDA, X ,INCX, Beta , Y, IncY) + CALL LAPACK_GEMV('n', 6 , 2*p%nCB, 1.0_ReKi, p%CMat, 6 , m%xFlat , 1, 1.0_ReKi, Fc, 1 ) ! = C*x + (F1r) + CALL LAPACK_GEMV('n', 6 , 18 , 1.0_ReKi, p%DMat, 6 , m%uFlat , 1, 1.0_ReKi, Fc, 1 ) ! + D*u + CALL LAPACK_GEMV('n', 6 , p%nCB , -1.0_ReKi, p%M12 , 6 , m%F_at_t(6+1:6+p%nCB), 1, 1.0_ReKi, Fc, 1 ) ! - M12*F2r + else + Fc = matmul(p%DMat, m%uFlat) + m%F_at_t(1:6) + endif + + ! Update the output mesh + do i=1,3 + y%PtfmMesh%Force(I,1) = Fc(I) + y%PtfmMesh%Moment(I,1) = Fc(I+3) + enddo + + ! --- All Outputs + m%AllOuts(ID_PtfFx) = y%PtfmMesh%Force (1,1) + m%AllOuts(ID_PtfFy) = y%PtfmMesh%Force (2,1) + m%AllOuts(ID_PtfFz) = y%PtfmMesh%Force (3,1) + m%AllOuts(ID_PtfMx) = y%PtfmMesh%Moment(1,1) + m%AllOuts(ID_PtfMy) = y%PtfmMesh%Moment(2,1) + m%AllOuts(ID_PtfMz) = y%PtfmMesh%Moment(3,1) + m%AllOuts(ID_InpFx) = m%F_at_t(1) + m%AllOuts(ID_InpFy) = m%F_at_t(2) + m%AllOuts(ID_InpFz) = m%F_at_t(3) + m%AllOuts(ID_InpMx) = m%F_at_t(4) + m%AllOuts(ID_InpMy) = m%F_at_t(5) + m%AllOuts(ID_InpMz) = m%F_at_t(6) + !y%WriteOutput(ID_WaveElev) = .. ! TODO + do i=1,p%nCB + m%AllOuts(ID_QStart + 0*p%nCBFull -1 + p%ActiveCBDOF(I)) = x%qm (I) ! CBQ - DOF Positions + m%AllOuts(ID_QStart + 1*p%nCBFull -1 + p%ActiveCBDOF(I)) = x%qmdot(I) ! CBQD - DOF Velocities + m%AllOuts(ID_QStart + 2*p%nCBFull -1 + p%ActiveCBDOF(I)) = m%F_at_t(6+I) ! CBF - DOF Forces + enddo + ! --- Selected output channels only + do I = 1,p%NumOuts + if (p%OutParam(I)%Indx>0) then + y%WriteOutput(I) = p%OutParam(I)%SignM * m%AllOuts( p%OutParam(I)%Indx ) + else + y%WriteOutput(I) = -9.9999e20 + endif + enddo END SUBROUTINE ExtPtfm_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -544,7 +763,6 @@ END SUBROUTINE ExtPtfm_CalcOutput !> This is a tight coupling routine for computing derivatives of continuous states. SUBROUTINE ExtPtfm_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -556,54 +774,74 @@ SUBROUTINE ExtPtfm_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, E TYPE(ExtPtfm_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + INTEGER(IntKi) :: I + ! Allocation of output dxdt (since intent(out)) + call AllocAry(dxdt%qm, p%nCB, 'dxdt%qm', ErrStat, ErrMsg); if(Failed()) return + call AllocAry(dxdt%qmdot, p%nCB, 'dxdt%qmdot', ErrStat, ErrMsg); if(Failed()) return + if ( p%nCB == 0 ) return + do I=1,p%nCB; dxdt%qm (I)=0; enddo + do I=1,p%nCB; dxdt%qmdot(I)=0; enddo + + ! Compute the loads `fr1 fr2` at t (fr1 without added mass) by time interpolation of the inputs loads p%F + call InterpStpMat(REAL(t,ReKi), p%times, p%Forces, m%Indx, p%nTimeSteps, m%F_at_t) + + ! u flat (x1, \dot{x1}, \ddot{x1}) + m%uFlat(1:3) = u%PtfmMesh%TranslationDisp(:,1) + m%uFlat(4:6) = GetSmllRotAngs(u%PtfmMesh%Orientation(:,:,1), ErrStat, ErrMsg); if(Failed()) return + m%uFlat(7:9 ) = u%PtfmMesh%TranslationVel(:,1) + m%uFlat(10:12) = u%PtfmMesh%RotationVel (:,1) + m%uFlat(13:15) = u%PtfmMesh%TranslationAcc(:,1) + m%uFlat(16:18) = u%PtfmMesh%RotationAcc (:,1) + + ! --- Computation of qm and qmdot + ! >>> Latex formulae: + ! \ddot{x2} = -K22 x2 - C22 \dot{x2} - C21 \dot{x1} - M21 \ddot{x1} + fr2 + ! >>> MATMUL IMPLEMENTATION + !dxdt%qm= x%qmdot + !dxdt%qmdot = - matmul(p%K22,x%qm) - matmul(p%C22,x%qmdot) & + ! - matmul(p%C21,m%uFlat(7:12)) - matmul(p%M21, m%uFlat(13:18)) + m%F_at_t(6+1:6+p%nCB) + ! >>> BLAS IMPLEMENTATION + ! COPY( N , X , INCX, Y , INCY) + CALL LAPACK_COPY(p%nCB, x%qmdot , 1 , dxdt%qm , 1 ) ! qmdot=qmdot + CALL LAPACK_COPY(p%nCB, m%F_at_t(6+1:6+p%nCB), 1 , dxdt%qmdot , 1 ) ! qmddot = fr2 + ! GEMV(TRS, M , N , alpha , A , LDA , X ,INCX, Beta , Y , IncY) + CALL LAPACK_GEMV('n', p%nCB, p%nCB , -1.0_ReKi, p%K22, p%nCB, x%qm , 1 , 1.0_ReKi, dxdt%qmdot, 1 ) ! - K22 x2 + CALL LAPACK_GEMV('n', p%nCB, 6 , -1.0_ReKi, p%C21, p%nCB, m%uFlat(7:12) , 1 , 1.0_ReKi, dxdt%qmdot, 1 ) ! - C21 \dot{x1} + CALL LAPACK_GEMV('n', p%nCB, p%nCB , -1.0_ReKi, p%C22, p%nCB, x%qmdot , 1 , 1.0_ReKi, dxdt%qmdot, 1 ) ! - C22 \dot{x2} + CALL LAPACK_GEMV('n', p%nCB, 6 , -1.0_ReKi, p%M21, p%nCB, m%uFlat(13:18), 1 , 1.0_ReKi, dxdt%qmdot, 1 ) ! - M21 \ddot{x1} - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Compute the first time derivatives of the continuous states here: - - dxdt%DummyContState = 0.0_ReKi - +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_CalcContStateDeriv') + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ExtPtfm_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- !> This is a tight coupling routine for updating discrete states. SUBROUTINE ExtPtfm_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval + TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t, Output: Discrete states at t + Interval TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - - ! Update discrete states here: - + ! Update discrete states here: xd%DummyDiscState = 0.0_Reki - END SUBROUTINE ExtPtfm_UpdateDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> This is a tight coupling routine for solving for the residual of the constraint state functions. SUBROUTINE ExtPtfm_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, m, Z_residual, ErrStat, ErrMsg ) !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -616,170 +854,178 @@ SUBROUTINE ExtPtfm_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, m, Z_ !! the input values described above INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - - ! Solve for the residual of the constraint state functions here: - + ! Solve for the residual of the constraint state functions here: Z_residual%DummyConstrState = 0.0_ReKi END SUBROUTINE ExtPtfm_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### ! If the module does not implement them, set ErrStat = ErrID_Fatal in ExtPtfm_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 ExtPtfm_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(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ExtPtfm_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdu. - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - - - ! Initialize ErrStat - + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ExtPtfm_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdu. + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with + !! respect to the inputs (u) [intent in to avoid deallocation] + INTEGER(IntKi) :: i,j ! Loop index + INTEGER(IntKi) :: idx ! Index of output channel in AllOuts + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - - - IF ( PRESENT( dYdu ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - + if (present(dYdu)) then ! allocate and set dYdu - - END IF - - IF ( PRESENT( dXdu ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, N_OUTPUTS+p%NumOuts, N_INPUTS, 'dYdu', ErrStat, ErrMsg); if(Failed()) return + do i=1,size(dYdu,1); do j=1,size(dYdu,2); dYdu(i,j)=0.0_ReKi; enddo;enddo + end if + dYdu(1:6,1:N_INPUTS) = p%DMat(1:6,1:N_INPUTS) + !dYdu is zero except if WriteOutput is the interface loads + do i = 1,p%NumOuts + idx = p%OutParam(i)%Indx + if (idx==ID_PtfFx) then; dYdu(6+i,1:N_INPUTS) = p%DMat(1,1:N_INPUTS) + elseif (idx==ID_PtfFy) then; dYdu(6+i,1:N_INPUTS) = p%DMat(2,1:N_INPUTS) + elseif (idx==ID_PtfFx) then; dYdu(6+i,1:N_INPUTS) = p%DMat(3,1:N_INPUTS) + elseif (idx==ID_PtfMz) then; dYdu(6+i,1:N_INPUTS) = p%DMat(4,1:N_INPUTS) + elseif (idx==ID_PtfMy) then; dYdu(6+i,1:N_INPUTS) = p%DMat(5,1:N_INPUTS) + elseif (idx==ID_PtfMz) then; dYdu(6+i,1:N_INPUTS) = p%DMat(6,1:N_INPUTS) + else ; dYdu(6+i,1:N_INPUTS) = 0.0_ReKi + endif + end do + end if + if (present(dXdu)) then ! allocate and set dXdu - - END IF - - IF ( PRESENT( dXddu ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: - - ! allocate and set dXddu - - END IF - - IF ( PRESENT( dZdu ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: - - ! allocate and set dZdu - - END IF - - + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, 2*p%nCB, N_INPUTS, 'dXdu', ErrStat, ErrMsg); if(Failed()) return + do i=1,size(dXdu,1); do j=1,size(dXdu,2); dXdu(i,j)=0.0_ReKi; enddo;enddo + end if + dXdu(1:2*p%nCB,1:N_INPUTS) = p%BMat(1:2*p%nCB,1:N_INPUTS) + end if + if (present(dXddu)) then + end if + if (present(dZdu)) then + end if +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_JacobianPInput') + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ExtPtfm_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 ExtPtfm_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(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ExtPtfm_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdx. - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - - ! Initialize ErrStat - + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtPtfm_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ExtPtfm_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ExtPtfm_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdx. + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions + !! (Y) with respect to the continuous + !! states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state + !! functions (X) with respect to + !! the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state + !! functions (Xd) with respect to + !! the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state + !! functions (Z) with respect to + !! the continuous states (x) [intent in to avoid deallocation] + INTEGER(IntKi) :: i,j ! Loop index + INTEGER(IntKi) :: idx ! Index of output channel in AllOuts + INTEGER(IntKi) :: iDOF ! Mode number + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - - - - IF ( PRESENT( dYdx ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - + if (present(dYdx)) then ! allocate and set dYdx - - END IF - - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, N_OUTPUTS+p%NumOuts, 2*p%nCB, 'dYdx', ErrStat, ErrMsg); if(Failed()) return + do i=1,size(dYdx,1); do j=1,size(dYdx,2); dYdx(i,j)=0.0_ReKi; enddo;enddo + end if + dYdx(1:6,1:2*p%nCB) = p%CMat(1:6, 1:2*p%nCB) + ! WriteOutputs + do i = 1,p%NumOuts + idx = p%OutParam(i)%Indx + iDOF = mod(idx-ID_QSTART, p%nCB)+1 + ! if output is an interface load dYdx is a row of the Cmatrix + if (idx==ID_PtfFx) then; dYdx(6+i,1:2*p%nCB) = p%CMat(1,1:2*p%nCB) + elseif (idx==ID_PtfFy) then; dYdx(6+i,1:2*p%nCB) = p%CMat(2,1:2*p%nCB) + elseif (idx==ID_PtfFx) then; dYdx(6+i,1:2*p%nCB) = p%CMat(3,1:2*p%nCB) + elseif (idx==ID_PtfMx) then; dYdx(6+i,1:2*p%nCB) = p%CMat(4,1:2*p%nCB) + elseif (idx==ID_PtfMy) then; dYdx(6+i,1:2*p%nCB) = p%CMat(5,1:2*p%nCB) + elseif (idx==ID_PtfMz) then; dYdx(6+i,1:2*p%nCB) = p%CMat(6,1:2*p%nCB) + ! Below we look at the index, we assumed an order for the outputs + ! where after the index ID_Qstart, the AllOutputs are: Q,QDot and Qf + ! An alternative coulbe to look at the name of the DOF instead: + ! e.g. if (index(p%OutParam,'CBQ_')>0) then ... (see SetOutParam) + else if ((idx-ID_QStart>= 0 ) .and. (idx-ID_QStart= p%nCB) .and. (idx-ID_QStart<2*p%nCB) ) then + ! Output is a DOF velocity, dYdx has a 1 at the proper location + dYdx(6+i,1:2*p%nCB ) = 0.0_ReKi + dYdx(6+i,p%nCB + iDOF) = 1.0_ReKi ! TODO TODO TODO ALLDOF_2_DOF + else ! e.g. WaveElevation or CB Forces + dYdx(6+i,1:2*p%nCB ) = 0.0_ReKi + endif + end do + end if + if (present(dXdx)) then ! allocate and set dXdx - - END IF - - IF ( PRESENT( dXddx ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: - - ! allocate and set dXddx - - END IF - - IF ( PRESENT( dZdx ) ) THEN - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx - - END IF - - + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, 2*p%nCB, 2*p%nCB, 'dXdx', ErrStat, ErrMsg); if(Failed()) return + do i=1,size(dXdx,1); do j=1,size(dXdx,2); dXdx(i,j)=0.0_ReKi; enddo;enddo + end if + dXdx(1:2*p%nCB,1:2*p%nCB) = p%AMat(1:2*p%nCB,1:2*p%nCB) + end if + if (present(dXddx)) then + end if + if (present(dZdx)) then + end if +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_JacobianPInput') + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ExtPtfm_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -801,66 +1047,34 @@ SUBROUTINE ExtPtfm_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrS TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions !! (Y) with respect to the discrete !! states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state !! functions (X) with respect to the !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state !! functions (Xd) with respect to the !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state !! functions (Z) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - - - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF - - + 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 ExtPtfm_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 ExtPtfm_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(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -875,63 +1089,31 @@ SUBROUTINE ExtPtfm_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, Er TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output + 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(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous + 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(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state + 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(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint - !! state functions (Z) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - - - ! Initialize ErrStat - + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - - END IF - - IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - - ! allocate and set dXdz - - END IF - - IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - - ! allocate and set dXddz - - END IF - - IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - - ! allocate and set dZdz - - END IF - - + if (present(dYdz)) then + end if + if (present(dXdz)) then + end if + if (present(dXddz)) then + end if + if (present(dZdz)) then + end if END SUBROUTINE ExtPtfm_JacobianPConstrState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE ExtPtfm_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(ExtPtfm_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters @@ -949,36 +1131,64 @@ SUBROUTINE ExtPtfm_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - - ! Initialize ErrStat - + INTEGER(IntKi) :: I + TYPE(ExtPtfm_ContinuousStateType) :: dx !< derivative of continuous states at operating point + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - - END IF - - IF ( PRESENT( y_op ) ) THEN - END IF - - IF ( PRESENT( x_op ) ) THEN - - END IF + if ( present( u_op ) ) then + if (.not. allocated(u_op)) then + call AllocAry(u_op, N_INPUTS, 'u_op', ErrStat, ErrMsg); if(Failed())return + endif + u_op(1:3) = u%PtfmMesh%TranslationDisp(:,1) + u_op(4:6) = GetSmllRotAngs(u%PtfmMesh%Orientation(:,:,1), ErrStat, ErrMsg); if(Failed())return + u_op(7:9 ) = u%PtfmMesh%TranslationVel(:,1) + u_op(10:12) = u%PtfmMesh%RotationVel (:,1) + u_op(13:15) = u%PtfmMesh%TranslationAcc(:,1) + u_op(16:18) = u%PtfmMesh%RotationAcc (:,1) + end if - IF ( PRESENT( dx_op ) ) THEN + if ( present( y_op ) ) then + if (.not. allocated(y_op)) then + call AllocAry(y_op, N_OUTPUTS+p%NumOuts, 'y_op', ErrStat, ErrMsg); if(Failed())return + endif + ! Update the output mesh + y_op(1:3)=y%PtfmMesh%Force(1:3,1) + y_op(4:6)=y%PtfmMesh%Moment(1:3,1) + do i=1,p%NumOuts + y_op(i+N_OUTPUTS) = y%WriteOutput(i) + end do + end if - END IF + if ( present( x_op ) ) then + if (.not. allocated(x_op)) then + call AllocAry(x_op, 2*p%nCB, 'x_op', ErrStat, ErrMsg); if (Failed())return + endif + x_op(1:p%nCB) = x%qm(1:p%nCB) + x_op(p%nCB+1:2*p%nCB) = x%qmdot(1:p%nCB) + end if - IF ( PRESENT( xd_op ) ) THEN + if ( present( dx_op ) ) then + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, 2*p%nCB, 'dx_op', ErrStat, ErrMsg); if (Failed())return + endif + call ExtPtfm_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dx, ErrStat, ErrMsg); if(Failed()) return + dx_op(1:p%nCB) = dx%qm(1:p%nCB) + dx_op(p%nCB+1:2*p%nCB) = dx%qmdot(1:p%nCB) + end if - END IF + if ( present( xd_op ) ) then + end if - IF ( PRESENT( z_op ) ) THEN - - END IF + if ( present( z_op ) ) then + end if +contains + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_GetOP') + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ExtPtfm_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Driver.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Driver.f90 index 1507e3ccc7..cdde2f09bb 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Driver.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Driver.f90 @@ -23,16 +23,14 @@ PROGRAM ExtPtfm_Driver USE NWTC_Library USE ExtPtfm_MCKF USE ExtPtfm_MCKF_Types - IMPLICIT NONE INTEGER(IntKi), PARAMETER :: NumInp = 1 !< Number of inputs sent to ExtPtfm_UpdateStates - - ! Program variables - + ! Program variables REAL(DbKi) :: Time !< Variable for storing time, in seconds REAL(DbKi) :: TimeInterval !< Interval between time steps, in seconds REAL(DbKi) :: InputTime(NumInp) !< Variable for storing time associated with inputs, in seconds + CHARACTER(1024) :: InputFile !< A CHARACTER string containing the name of the primary input file TYPE(ExtPtfm_InitInputType) :: InitInData !< Input data for initialization TYPE(ExtPtfm_InitOutputType) :: InitOutData !< Output data from initialization @@ -43,86 +41,65 @@ PROGRAM ExtPtfm_Driver TYPE(ExtPtfm_ConstraintStateType) :: Z_residual !< Residual of the constraint state functions (Z) TYPE(ExtPtfm_OtherStateType) :: OtherState !< Other states TYPE(ExtPtfm_MiscVarType) :: misc !< Optimization variables - TYPE(ExtPtfm_ParameterType) :: p !< Parameters TYPE(ExtPtfm_InputType) :: u(NumInp) !< System inputs TYPE(ExtPtfm_OutputType) :: y !< System outputs - - + ! INTEGER(IntKi) :: n !< Loop counter (for time step) INTEGER(IntKi) :: ErrStat !< Status of error message CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - !............................................................................................................................... ! Routines called in initialization !............................................................................................................................... + InputFile='' + call CheckArgs(InputFile, ErrStat) + ! Populate the InitInData data structure here: + IF (LEN_TRIM(InputFile) == 0) THEN ! no input file was specified + ErrStat = ErrID_Fatal + ErrMsg = 'The required input file was not specified on the command line.' + CALL WrScr( ErrMsg ) + STOP 1 + END IF - ! Populate the InitInData data structure here: - - InitInData%InputFile = 'MyInputFileName.inp' - - ! Set the driver's request for time interval here: - - TimeInterval = 0.25 ! Glue code's request for delta time (likely based on information from other modules) - - - ! Initialize the module + InitInData%InputFile = InputFile + TimeInterval = 0.001 ! Glue code's request for delta time (likely based on information from other modules) + ! Initialize the module CALL ExtPtfm_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) END IF - - ! Destroy initialization data - + ! Destroy initialization data CALL ExtPtfm_DestroyInitInput( InitInData, ErrStat, ErrMsg ) CALL ExtPtfm_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) - !............................................................................................................................... ! Routines called in loose coupling -- the glue code may implement this in various ways !............................................................................................................................... - - DO n = 0,2 - Time = n*TimeInterval InputTime(1) = Time - - ! Modify u (likely from the outputs of another module or a set of test conditions) here: - - - ! Calculate outputs at n - + ! Modify u (likely from the outputs of another module or a set of test conditions) here: + ! Calculate outputs at n CALL ExtPtfm_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) END IF - - - ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 - + ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 CALL ExtPtfm_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) END IF - - END DO - - !............................................................................................................................... ! Routine to terminate program execution !............................................................................................................................... CALL ExtPtfm_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN CALL WrScr( ErrMsg ) + STOP 1 END IF - - END PROGRAM ExtPtfm_Driver diff --git a/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 b/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 new file mode 100644 index 0000000000..d0e2868d13 --- /dev/null +++ b/modules/extptfm/src/ExtPtfm_MCKF_IO.f90 @@ -0,0 +1,911 @@ +!********************************************************************************************************************************** +! The ExtPtfm_MCKF.f90, ExtPtfm_MCKF_IO.f90 and ExtPtfm_MCKF_Types.f90 make up the ExtPtfm_MCKF module of the +! FAST Modularization Framework. ExtPtfm_MCKF_Types is auto-generated based on FAST_Registry.txt. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! This file is part of ExtPtfm_MCKF. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +!********************************************************************************************************************************** +!> This module contains definitions of compile-time PARAMETERS for the ExtPtfm_MCKF module. +!! Every variable defined here MUST have the PARAMETER attribute. +MODULE ExtPtfm_MCKF_Parameters + USE NWTC_Library + + TYPE(ProgDesc), PARAMETER :: ExtPtfm_Ver = ProgDesc( 'ExtPtfm_MCKF', '', '' ) !< module date/version information + ! + INTEGER(IntKi), parameter :: N_INPUTS = 18 + INTEGER(IntKi), parameter :: N_OUTPUTS = 6 + + + CHARACTER(len=4), DIMENSION(3), PARAMETER :: StrIntMethod = (/'RK4 ','AB4 ','ABM4'/) + + ! Variables for output channels + INTEGER(IntKi), PARAMETER :: FILEFORMAT_GUYANASCII = 0 + INTEGER(IntKi), PARAMETER :: FILEFORMAT_FLEXASCII = 1 + + ! 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 + INTEGER(IntKi), PARAMETER :: ID_PtfFz = 3 + INTEGER(IntKi), PARAMETER :: ID_PtfMx = 4 + INTEGER(IntKi), PARAMETER :: ID_PtfMy = 5 + INTEGER(IntKi), PARAMETER :: ID_PtfMz = 6 + INTEGER(IntKi), PARAMETER :: ID_WaveElev = 7 + INTEGER(IntKi), PARAMETER :: ID_InpFx = 8 + INTEGER(IntKi), PARAMETER :: ID_InpFy = 9 + INTEGER(IntKi), PARAMETER :: ID_InpFz = 10 + INTEGER(IntKi), PARAMETER :: ID_InpMx = 11 + INTEGER(IntKi), PARAMETER :: ID_InpMy = 12 + INTEGER(IntKi), PARAMETER :: ID_InpMz = 13 + INTEGER(IntKi), PARAMETER :: ID_QStart = 14 +END MODULE ExtPtfm_MCKF_Parameters + +!********************************************************************************************************************************** +!> This module contains file I/O routines and data validation routines. +MODULE ExtPtfm_MCKF_IO + + USE ExtPtfm_MCKF_Parameters + USE ExtPtfm_MCKF_Types + + IMPLICIT NONE + private + + public :: ReadPrimaryFile + public :: SetOutParam + public :: ExtPtfm_PrintSum + +CONTAINS +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Helper functions for the module +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the error status and error message for a routine, it's a simplified version of SetErrStat from NWTC_Library +subroutine SetErrStatSimple(ErrStat, ErrMess, RoutineName, LineNumber) + INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None + CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in + INTEGER(IntKi), INTENT(IN), OPTIONAL :: LineNumber ! Line of input file + if (ErrStat /= ErrID_None) then + print*,'ErrMess',ErrMess + write(ErrMess,'(A)') TRIM(RoutineName)//':'//TRIM(ErrMess) + if (present(LineNumber)) then + ErrMess = TRIM(ErrMess)//' Line: '//TRIM(Num2LStr(LineNumber))//'.' + endif + end if +end subroutine SetErrStatSimple + +subroutine disp2r8(u,varname,a) + integer,intent(in) ::u + character(len=*),intent(in)::varname + real(ReKi),intent(in),dimension(:,:) ::a + integer :: n, m,i + character(len=20) :: fmt + character(len=*),parameter :: RFMT='EN13.3E2' + n=size(a,1) + m=size(a,2) + if (n>0 .and. m>0) then + write(u,"(A,A)") varname,"=[" + write(fmt,*) m + do i=1,n-1 + write(u,"("//adjustl(fmt)//RFMT//")") a(i,:) + enddo + i=n + write(u,"("//trim(fmt)//RFMT//",A)") a(i,:), " ];" + else + write(u,'(A,A)') varname,'=[];' + endif +end subroutine +subroutine disp1r8(u,varname,a) + integer,intent(in) ::u + character(len=*),intent(in)::varname + real(ReKi),intent(in),dimension(:) ::a + integer :: n + character(len=20) :: fmt + character(len=*),parameter :: RFMT='EN13.3E2' + n=size(a,1) + if (n>0) then + write(fmt,*) n + write(u,"(A,"//adjustl(fmt)//RFMT//",A)") varname//" =[ ", a(:), " ];" + else + write(u,'(A,A)') varname,'=[];' + endif +end subroutine +subroutine disp1i(u,varname,a) + integer,intent(in) ::u + character(len=*),intent(in)::varname + integer(IntKi),intent(in),dimension(:) ::a + integer :: n + character(len=20) :: fmt + character(len=*),parameter :: RFMT='I5' + n=size(a,1) + if (n>0) then + write(fmt,*) n + write(u,"(A,"//adjustl(fmt)//RFMT//",A)") varname//" =[ ", a(:), " ];" + else + write(u,'(A,A)') varname,'=[];' + endif +end subroutine + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Helper functions to read primary file +real(ReKi) function ReadFloatFromStr(s, VarName, iStat, Msg ) result(myfloat) + character(len=*), intent(in) :: s + character(len=*), intent(in) :: VarName + character(len=*), intent(inout) :: Msg + integer, intent(out) :: iStat + read(s,*, iostat=iStat ) myfloat + if (iStat /= 0) then + iStat=ErrID_Fatal + Msg = trim(Msg)//'Error extracting float while reading '//VarName + endif +end function ReadFloatFromStr +integer function ReadIntFromStr(s, VarName, iStat, Msg ) result(myint) + character(len=*), intent(in) :: s + character(len=*), intent(in) :: VarName + character(len=*), intent(inout) :: Msg + integer, intent(out) :: iStat + read(s,*, iostat=iStat ) myint + if (iStat /= 0) then + iStat=ErrID_Fatal + Msg = trim(Msg)//'Error extracting integer while reading '//VarName + endif +end function ReadIntFromStr +subroutine ReadRealMatrix(fid, FileName, Mat, VarName, nLines,nRows, iStat, Msg, iLine ) + integer, intent(in) :: fid + real(ReKi), dimension(:,:), allocatable :: Mat + character(len=*), intent(in) :: FileName + character(len=*), intent(in) :: VarName + integer, intent(in) :: nLines + integer, intent(in) :: nRows + integer, intent(out) :: iStat + integer, intent(inout) :: iLine + character(len=*), intent(inout) :: Msg + ! local variables + integer :: i + call allocAry( Mat, nLines, nRows, VarName, iStat, Msg); + if (iStat /= 0) return + !Read Stiffness + DO I =1,nLines + iLine=iLine+1 + ! TODO use ReadCAryFromStr when available in the NWTCIO, it performs more checks + CALL ReadAry( fid, FileName, Mat(I,:), nRows, trim(VarName)//' Line '//Num2LStr(iLine), VarName, iStat, Msg) + if (iStat /= 0) return + ENDDO +end subroutine + + +SUBROUTINE SetOutParam(OutList, NumOuts_in, p, ErrStat, ErrMsg ) +! This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +! warning if any of the channels are not available outputs from the module. +! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +! the sign is set to 0 if the channel is invalid. +! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!.................................................................................................................................. + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + INTEGER(IntKi), INTENT(IN) :: NumOuts_in !< Effective number of output channels + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + ! Local variables + INTEGER :: I ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(13) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "INPF_FX ","INPF_FY ","INPF_FZ ","INPF_MX ","INPF_MY ","INPF_MZ ",& + "INTRFFX ","INTRFFY ","INTRFFZ ","INTRFMX ","INTRFMY ","INTRFMZ ",& + "WAVELEV "/) + CHARACTER(OutStrLenM1), PARAMETER :: ParamUnitsAry(13) = (/ & ! This lists the units corresponding to the allowed parameters + "(N) ","(N) ","(N) ","(Nm) ","(Nm) ","(Nm) ",& + "(N) ","(N) ","(N) ","(Nm) ","(Nm) ","(Nm) ","(m) "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(13) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + ID_InpFx, ID_InpFy, ID_InpFz, ID_InpMx, ID_InpMy, ID_InpMz,& + ID_PtfFx, ID_PtfFy, ID_PtfFz, ID_PtfMx, ID_PtfMy, ID_PtfMz,& + ID_WaveElev /) + character(ErrMsgLen) :: WarnMsg !Warning Message + ErrStat = ErrID_None + ErrMsg = "" + WarnMsg = "" + + p%NumOuts = NumOuts_in + allocate(p%OutParam(0:p%NumOuts) , stat=ErrStat ) + if ( ErrStat /= 0_IntKi ) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating memory for the InflowWind OutParam array.", ErrStat, ErrMsg, RoutineName) + return + endif + + ! Set index, name, and units for the time output channel: + p%OutParam(0)%Indx = 0 + p%OutParam(0)%Name = "Time" ! OutParam(0) is the time channel by default. + p%OutParam(0)%Units = "(s)" + p%OutParam(0)%SignM = 1 + + ! Set index, name, and units for all of the output channels. + do I = 1,p%NumOuts + p%OutParam(I)%Name = OutList(I) + OutListTmp = OutList(I) + p%OutParam(I)%Indx = 0 + p%OutParam(I)%Units = "(NA)" + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + ! Reverse the sign of the channel if the prefix is "-", "_" or "M" + if ( index( "-_M", OutListTmp(1:1) ) > 0 ) then + p%OutParam(I)%SignM = -1 + OutListTmp = OutListTmp(2:) + else + p%OutParam(I)%SignM = 1 + end if + ! Find the index of the channel in the AllOut list + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + if (Indx>0) then + p%OutParam(I)%Indx = ParamIndxAry(Indx) + p%OutParam(I)%Units = ParamUnitsAry(Indx) + else if (index(OutListTmp,'CBQ_') > 0 ) then + call setDOFChannel(5,ID_QStart+0*p%nCBFull-1); if(Failed()) return ! NOTE: using full CB + else if (index(OutListTmp,'CBQD_') > 0 ) then + call setDOFChannel(6,ID_QStart+1*p%nCBFull-1); if(Failed()) return ! NOTE: using full CB + else if (index(OutListTmp,'CBF_') > 0 ) then + call setDOFChannel(5,ID_QStart+2*p%nCBFull-1); if(Failed()) return ! NOTE: using full CB + else + call setInvalidChannel() ! INVALID + endif + !write(*,*) p%OutParam(I)%Name, p%OutParam(I)%Indx, p%OutParam(I)%Units + end do + if (len(WarnMsg)>0) then + call SetErrStat(ErrID_Warn, WarnMsg,ErrStat,ErrMsg,'ExtPtfm_SetOutParam') + write(*,'(A)')trim(WarnMsg) + endif + return +contains + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_SetOutParam') + Failed = ErrStat >= AbortErrLev + end function Failed + subroutine setDOFChannel(nCharBefore,nOffset) + !> Sets channel when the channel name has the form "YYYY_XXX" where XXX is a DOF number + integer, intent(in) :: nCharBefore !< Number of characters to ignore in OutListTmp + integer, intent(in) :: nOffset !< Index offset to add to iDOF + integer :: idof ! index of CB DOF extracted from + iDOF = ReadIntFromStr(OutListTmp(nCharBefore:), 'Output channel '//trim(OutList(I)), ErrStat, ErrMsg); + if(ErrStat/=0) return + if ( any( p%ActiveCBDOF== iDOF ) ) then + p%OutParam(I)%Indx = nOffset+iDOF + p%OutParam(I)%Units = '(-)' + else +! if ((iDOF> p%nCB) .or. (iDOF<1)) then + call setInvalidChannel() ! INVALID +! else + endif + end subroutine + subroutine setInvalidChannel() + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + p%OutParam(I)%Units = "INVALID" + p%OutParam(I)%Indx = 0 + WarnMsg=trim(WarnMsg)//TRIM(p%OutParam(I)%Name)//" is not an available output channel."//CHAR(10) +! call SetErrStat(ErrID_Warn, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,'ExtPtfm_SetOutParam') +! write(*,*)TRIM(p%OutParam(I)%Name)//" is not an available output channel." + end subroutine +END SUBROUTINE SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!> Checks that all inputs were correctly read +subroutine CheckInputs(Inp, p, ErrStat, ErrMsg) + TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: Inp !< Data stored in the module's input file + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< All the parameter matrices stored in this input file + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + ErrStat = ErrID_None + ErrMsg = "" + if (ErrStat/=0) return + if (p%nTot<0) then ; ErrStat=ErrID_Fatal; ErrMsg='The total number of DOF was not set'; return; endif + if (.not.allocated(p%Mass)) then ; ErrStat=ErrID_Fatal; ErrMsg='The mass matrix was not allocated.' ; return; endif + if (.not.allocated(p%Stff)) then ; ErrStat=ErrID_Fatal; ErrMsg='The stiffness matrix was not allocated.' ; return; endif + if (.not.allocated(p%Damp)) then ; ErrStat=ErrID_Fatal; ErrMsg='The damping matrix was not allocated.' ; return; endif + if (.not.allocated(p%Forces)) then ; ErrStat=ErrID_Fatal; ErrMsg='The loads were not allocated.';return; endif + if (.not.allocated(p%times)) then ; ErrStat=ErrID_Fatal; ErrMsg='The time vector was not allocated.'; return; endif + if (allocated(Inp%ActiveCBDOF)) then + if (maxval(Inp%ActiveCBDOF)>size(p%Mass,1)-6) then + ErrStat=ErrID_Fatal; ErrMsg='The maximum index of `ActiveCBDOF` (active CB DOF) should be less than the total number of CB DOF.'; return; + endif + endif +end subroutine CheckInputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadPrimaryFile(InputFile, p, OutFileRoot, InputFileData, ErrStat, ErrMsg) +!.................................................................................................................................. + ! Passed variables + CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< All the parameter matrices stored in this input file + CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of all the output files written by this routine. + TYPE(ExtPtfm_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + ! Local variables: + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: N ! Number of list elements + INTEGER(IntKi) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: UnEc ! Unit number for echo + INTEGER(IntKi) :: iLine ! Current position in file + CHARACTER(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") + CHARACTER(1024) :: PriPath ! Path name of the primary file + LOGICAL :: Echo + ! --- Initialization + ErrStat = ErrID_None + ErrMsg = "" + Echo = .FALSE. + UnEc = -1 ! Echo file not opened, yet + CALL GetPath(InputFile, PriPath) ! Input files will be relative to the path where the primary input file is located. + CALL AllocAry(InputFileData%OutList, MaxOutChs, "ExtPtfm Input File's Outlist", ErrStat, ErrMsg); if(Failed()) return + + ! Get an available unit number for the file. + CALL GetNewUnit(UnIn, ErrStat, ErrMsg); if(Failed()) return + ! Open the Primary input file. + CALL OpenFInpFile(UnIn, InputFile, ErrStat, ErrMsg); if(Failed()) return + + ! Read the lines up/including to the "Echo" simulation control variable + ! If echo is FALSE, don't write these lines to the echo file. + ! If Echo is TRUE, rewind and write on the second try. + I = 1 ! the number of times we've read the file (used for the Echo variable) + DO + iLine=1 + !-------------------------- HEADER --------------------------------------------- + CALL ReadCom(UnIn, InputFile, 'File Header', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return; + CALL ReadStr(UnIn, InputFile, Line, 'Header', 'File Header: File Description', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + !---------------------- SIMULATION CONTROL -------------------------------------- + CALL ReadCom(UnIn, InputFile, 'Section Header: Simulation Control', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + ! Echo - Echo input to ".ech". + CALL ReadVar(UnIn, InputFile, Echo, 'Echo','Echo switch', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop + ! Otherwise, open the echo file, then rewind the input file and echo everything we've read + I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) + CALL OpenEcho(UnEc, TRIM(OutFileRoot)//'.ech', ErrStat, ErrMsg, ExtPtfm_Ver ); if(Failed()) return; + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(ExtPtfm_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' + REWIND( UnIn, IOSTAT=ErrStat ) + IF (ErrStat /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".',ErrStat,ErrMsg,'ExtPtfm_ReadPrimaryFile' ); + IF (ErrStat >= AbortErrLev) RETURN + END IF + END DO + + IF (NWTC_VerboseLevel == NWTC_Verbose) THEN + CALL WrScr(' Heading of the '//TRIM(ExtPtfm_Ver%Name)//' input file: ') + CALL WrScr(' '//TRIM( Line )) + END IF + + ! DT - Requested integration time for ElastoDyn (seconds): + InputFileData%DT=-1 + CALL ReadVar( UnIn, InputFile, Line, "DT", "Integration time for ExtPtfm (s)", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + CALL Conv2UC( Line ) + IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DT + READ(Line, *, IOSTAT=ErrStat) InputFileData%DT + IF ( ErrStat /= 0 ) THEN + CALL CheckIOS(ErrStat, InputFile, "DT", NumType, ErrStat, ErrMsg); if(Failed()) return + END IF + END IF + ! Method - Integration method for loose coupling + CALL ReadVar( UnIn, InputFile, InputFileData%IntMethod, "IntMethod", "Integration method for ExtPtfm {1: RK4, 2: AB4, or 3: ABM4}", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + + !---------------------- REDUCTION INPUTS --------------------------------------------------- + CALL ReadCom(UnIn, InputFile, 'Section Header: ReductionInputs', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! File Format switch + CALL ReadVar(UnIn, InputFile, InputFileData%FileFormat, "FileFormat", "File format switch", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! Reduction Filename + CALL ReadVar(UnIn, InputFile, InputFileData%RedFile , 'Red_FileName', 'Path containing Guyan/Craig-Bampton inputs', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + IF ( PathIsRelative(InputFileData%RedFile) ) InputFileData%RedFile = TRIM(PriPath)//TRIM(InputFileData%RedFile) + CALL ReadVar(UnIn, InputFile, InputFileData%RedFileCst, 'RedCst_FileName', 'Path containing Guyan/Craig-Bampton constant inputs', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + IF ( PathIsRelative(InputFileData%RedFileCst) ) InputFileData%RedFileCst = TRIM(PriPath)//TRIM(InputFileData%RedFileCst) + CALL ReadVar(UnIn, InputFile, N , 'NActiveCBDOF','Number of active CB mode listed in ActiveCBDOF, -1 for all modes', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + if (N<0) then + CALL ReadCom(UnIn, InputFile, 'ActiveCBDOF', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + elseif (N==0) then + ! Allocating ActiveDOF of size 0 => Guyan modes only + CALL AllocAry(InputFileData%ActiveCBDOF, N, 'ActiveCBDOF', ErrStat, ErrMsg ); if (Failed()) return + CALL ReadCom(UnIn, InputFile, 'ActiveCBDOF', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + else + CALL AllocAry(InputFileData%ActiveCBDOF, N, 'ActiveCBDOF', ErrStat, ErrMsg ); if (Failed()) return + CALL ReadAry(UnIn, InputFile, InputFileData%ActiveCBDOF, N, 'ActiveCBDOF', 'List of active CB modes', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + endif + ! TODO TODO TODO CALL ReadVar(UnIn, InputFile, InputFileData%EquilStart, 'EquilStart','Find the equilibrium initial positions for the CB modes', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + CALL ReadVar(UnIn, InputFile, N , 'NInitPosList','Number of initial positions listed in InitPosList', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + if (N<=0) then + CALL ReadCom(UnIn, InputFile, 'InitPosList', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + else + CALL AllocAry(InputFileData%InitPosList, N, 'InitPosList', ErrStat, ErrMsg ); if (Failed()) return + CALL ReadAry(UnIn, InputFile, InputFileData%InitPosList, N, 'InitPosList', 'Initial positions', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + endif + CALL ReadVar(UnIn, InputFile, N , 'NInitVelList','Number of initial velocties listed in InitVelList', ErrStat, ErrMsg, UnEc ); if(LineFailed()) return + if (N<=0) then + CALL ReadCom(UnIn, InputFile, 'InitVelList', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + else + CALL AllocAry(InputFileData%InitVelList, N, 'InitVelList', ErrStat, ErrMsg ); if (Failed()) return + CALL ReadAry(UnIn, InputFile, InputFileData%InitVelList, N, 'InitVelList', 'Initial velocities', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + endif + !---------------------- OUTPUT -------------------------------------------------- + CALL ReadCom(UnIn, InputFile, 'Section Header: Output', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! SumPrint - Print summary data to .sum (flag): + CALL ReadVar(UnIn, InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! OutFile - Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) (-): + CALL ReadVar(UnIn, InputFile, InputFileData%OutFile , "OutFile", "Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) (-)", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! TabDelim - Flag to cause tab-delimited text output (delimited by space otherwise) (flag): + CALL ReadVar(UnIn, InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! OutFmt - Format used for module's text tabular output (except time); resulting field should be 10 characters (-): + CALL ReadVar(UnIn, InputFile, InputFileData%OutFmt , "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! Tstart - Time to start module's tabular output (seconds): + CALL ReadVar(UnIn, InputFile, InputFileData%Tstart , "Tstart", "Time to start module's tabular output (seconds)", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + !---------------------- OUTLIST -------------------------------------------- + CALL ReadCom(UnIn, InputFile, 'Section Header: OutList', ErrStat, ErrMsg, UnEc); if(LineFailed()) return + ! OutList - List of user-requested output channels (-): + CALL ReadOutputList(UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat, ErrMsg, UnEc); if(LineFailed()) return + !---------------------- END OF FILE ----------------------------------------- + call cleanup() + + ! --- Reading Reduced file + call ReadReducedFile(InputFileData%RedFile, p, InputFileData%FileFormat, ErrStat, ErrMsg); if(Failed()) return; + ! Checking that everyting was correctly read and set + call CheckInputs(InputFileData, p, ErrStat, ErrMsg); if(Failed()) return + + + ! --- Reducing the number of DOF if needed + p%nCBFull=p%nCB + if (allocated(InputFileData%ActiveCBDOF)) then + call allocAry(p%ActiveCBDOF, size(InputFileData%ActiveCBDOF), 'ActiveCBDOF', ErrStat, ErrMsg); if(Failed()) return + do I=1,size(InputFileData%ActiveCBDOF) + p%ActiveCBDOF(I) = InputFileData%ActiveCBDOF(I); + enddo + call ReduceNumberOfDOF(p, ErrStat, ErrMsg); + else + call allocAry(p%ActiveCBDOF, p%nCBFull, 'ActiveCBDOF', ErrStat, ErrMsg); if(Failed()) return + do I=1,p%nCBFull + p%ActiveCBDOF(I) = I + enddo + endif + + return + +CONTAINS + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_ReadPrimaryFile') + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + logical function LineFailed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_ReadPrimaryFile',iLine) + LineFailed = ErrStat >= AbortErrLev + if(LineFailed) call cleanup() + iLine=iLine+1 ! Increase line number + end function LineFailed + subroutine cleanup() + if (UnIn>0) close(UnIn) + if (UnEc>0) close(UnEc) + end subroutine cleanup +END SUBROUTINE ReadPrimaryFile + +!> Reduce the number of degrees of freedom given as input +SUBROUTINE ReduceNumberOfDOF(p, ErrStat, ErrMsg) + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< All the parameter matrices stored in this input file + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + integer(IntKi) :: nActive + integer(IntKi), dimension(:), allocatable :: FullActiveCBDOF + integer(IntKi) :: I + + ! Preprending 1-6 to ActiveDOF + call allocAry(FullActiveCBDOF, size(p%ActiveCBDOF)+6, 'FullActiveCBDOF', ErrStat, ErrMsg); if(Failed()) return + FullActiveCBDOF(1:6)=(/1,2,3,4,5,6/) + do I=1,size(p%ActiveCBDOF); + FullActiveCBDOF(I+6)=p%ActiveCBDOF(I)+6; + enddo + nActive=size(FullActiveCBDOF) + + ! Reducing matrices and load matrix + call SquareMatRed(p%Mass) + call SquareMatRed(p%Stff) + call SquareMatRed(p%Damp) + call TimeMatRed(p%Forces) + + ! Trigger + p%nCB = size(p%ActiveCBDOF) + p%nTot= p%nCB+6 +CONTAINS + !> Takes M and returns M(I,I) where I is a list of indexes to keep + subroutine SquareMatRed(M) + real(Reki), dimension(:,:), allocatable :: M + real(Reki), dimension(:,:), allocatable :: tmp + integer(IntKi) :: I,J + ! Storing M to a tmp array + call allocAry( tmp, size(M,1), size(M,2), 'Mtmp', ErrStat, ErrMsg); if(Failed()) return + tmp=M + ! Reallocating M and storing only the desired DOF + deallocate(M) + call allocAry(M, nActive, nActive, 'M', ErrStat, ErrMsg); if(Failed()) return + do I=1,nActive + do J=1,nActive + M(I,J) = tmp(FullActiveCBDOF(I), FullActiveCBDOF(J)) + enddo + enddo + deallocate(tmp) + end subroutine + !> Takes M and returns M(:,I) where I is a list of indexes to keep + subroutine TimeMatRed(M) + real(Reki), dimension(:,:), allocatable :: M + real(Reki), dimension(:,:), allocatable :: tmp + integer(IntKi) :: I,J + ! Storing M to a tmp array + call allocAry( tmp, size(M,1), size(M,2), 'MTimeTmp', ErrStat, ErrMsg); if(Failed()) return + tmp=M + ! Reallocating M and storing only the desired DOF + deallocate(M) + call allocAry(M, size(tmp,1), nActive, 'MTime', ErrStat, ErrMsg); if(Failed()) return + do I=1,size(tmp,1) + do J=1,nActive + M(I,J) = tmp(I, FullActiveCBDOF(J)) + enddo + enddo + deallocate(tmp) + end subroutine + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_ReduceNumberOfDOF') + Failed = ErrStat >= AbortErrLev + end function Failed +END SUBROUTINE ReduceNumberOfDOF + + +!.................................................................................................................................. +SUBROUTINE ReadReducedFile( InputFile, p, FileFormat, ErrStat, ErrMsg ) +!.................................................................................................................................. + ! Passed variables + CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: p !< All the parameter matrices stored in this input file + INTEGER(IntKi), INTENT(IN) :: FileFormat !< File format for reduction inputs + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + ! Local variables: + REAL(ReKi), dimension(:),allocatable :: TmpAry ! temporary array for reading row from file + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: iLine ! Current position in file + CHARACTER(4096) :: Line ! Temporary storage of a line from the input file (to compare with "default") + ErrStat = ErrID_None + ErrMsg = "" + if (FileFormat==FILEFORMAT_GUYANASCII) then + call ReadGuyanASCII() + elseif (FileFormat==FILEFORMAT_FLEXASCII) then + call ReadFlexASCII() + else + call SetErrStat(ErrID_Fatal, 'FileFormat not implemented: '//trim(Num2LStr(FileFormat)), ErrStat, ErrMsg, 'ExtPtfm_ReadReducedFile') + return + endif + ! --- The code below can detect between FlexASCII and GuyanASCII format by looking at the two first lines + ! Get an available unit number for the file. + !CALL GetNewUnit( UnIn, ErrStat, ErrMsg ); if(Failed()) return + !! Open the Primary input file. + !CALL OpenFInpFile ( UnIn, InputFile, ErrStat, ErrMsg ); if(Failed()) return + !iLine=1 + !!-------------------------- Read the first two lines + !CALL ReadStr( UnIn, InputFile, Line, 'Line'//Num2LStr(iLine), 'External Platform MCKF file', ErrStat, ErrMsg) + !if(Failed()) return + !iLine=iLine+1 + !CALL ReadStr( UnIn, InputFile, Line2, 'Line'//Num2LStr(iLine), 'External Platform MCKF file', ErrStat, ErrMsg) + !if(Failed()) return + !iLine=iLine+1 + !call CONV2UC(Line) + !call CONV2UC(Line2) + !call cleanup() + !!-------------------------- Detecting file format + !if (index(Line2,'#MASS')==1) then + ! write(*,*) 'File detected as Guyan ASCII file format: '//trim(InputFile) + ! call ReadGuyanASCII() + !else if (index(Line2,'FLEX 5 FORMAT')>=1) then + ! write(*,*) 'File detected as FLEX ASCII file format: '//trim(InputFile) + ! call ReadFlexASCII() + !endif + +CONTAINS + !> + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_ReadReducedFile') + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + !> + subroutine cleanup() + close( UnIn ) + if (allocated(TmpAry)) deallocate(TmpAry) + end subroutine cleanup + + !> Reads a FLEX ASCII file for Guyan or CraigBampton reductions + SUBROUTINE ReadFlexASCII() + REAL(ReKi) :: dt !< time step + REAL(ReKi) :: T !< total simulation time + + T=-1 + dt=-1 + ! Get an available unit number for the file. + CALL GetNewUnit( UnIn, ErrStat, ErrMsg ); if ( ErrStat /= 0 ) return + ! Open the Primary input file. + CALL OpenFInpFile(UnIn, InputFile, ErrStat, ErrMsg); if ( ErrStat /= 0 ) return + + ! --- Reading file line by line + ErrStat=0 + iLine=0 + do while (ErrStat==0) + iLine=iLine+1 + read(UnIn,'(A)', iostat=ErrStat) Line + if (ErrStat/=0) then + if (ErrStat < 0) then + ErrStat=0 ! End of file is fine + else + ErrMsg='Error while reading file '//trim(InputFile)// ' line '//Num2LStr(iLine) + endif + exit + endif + ! Line content is analyzed as case incensitive + call Conv2UC(Line) + if (index(Line,'!DIMENSION')==1) then + p%nTot = ReadIntFromStr(Line(12:), '`dimension`, file '//trim(InputFile)//', line '//Num2LStr(iLine), ErrStat, ErrMsg); if (ErrStat /= 0) exit + p%nCB=p%nTot-6 + + else if (index(Line,'!TIME INCREMENT IN SIMULATION:')==1) then + dt = ReadFloatFromStr(Line(31:), '`time increment`, file '//trim(InputFile)//', line '//Num2LStr(iLine), ErrStat, ErrMsg); if (ErrStat /= 0) exit + + else if (index(Line,'!TOTAL SIMULATION TIME IN FILE:')==1) then + T = ReadFloatFromStr(Line(32:), '`total simulation time`, file '//trim(InputFile)//', line '//Num2LStr(iLine), ErrStat, ErrMsg ); if (ErrStat /= 0) exit + + else if (index(Line,'!MASS MATRIX')==1) then + iLine=iLine+1 + CALL ReadCom( UnIn, InputFile, 'Comment - Line '//Num2LStr(iLine), ErrStat, ErrMsg); if (ErrStat /= 0) exit + if (p%nTot<0) exit + call ReadRealMatrix(UnIn, InputFile, p%Mass, 'Mass Matrix', p%nTot, p%nTot, ErrStat, ErrMsg, iLine) + + else if (index(Line,'!STIFFNESS MATRIX')==1) then + iLine=iLine+1 + CALL ReadCom( UnIn, InputFile, 'Comment - Line '//Num2LStr(iLine), ErrStat, ErrMsg); if (ErrStat /= 0) exit + if (p%nTot<0) exit + call ReadRealMatrix(UnIn, InputFile, p%Stff, 'Stiffness Matrix', p%nTot, p%nTot, ErrStat, ErrMsg, iLine) + + else if (index(Line,'!DAMPING MATRIX')==1) then + iLine=iLine+1 + CALL ReadCom( UnIn, InputFile, 'Comment - Line '//Num2LStr(iLine), ErrStat, ErrMsg); if (ErrStat /= 0) exit + if (p%nTot<0) exit + call ReadRealMatrix(UnIn, InputFile, p%Damp, 'Damping Matrix', p%nTot, p%nTot, ErrStat, ErrMsg, iLine) + + else if (index(Line,'!LOADING')==1) then + iLine=iLine+1 + CALL ReadCom( UnIn, InputFile, 'Comment - Line '//Num2LStr(iLine), ErrStat, ErrMsg) + if (ErrStat /= 0) exit + p%nTimeSteps = nint(T/dt)+1 + if (p%nTot<0) exit + call allocAry( p%Forces, max(1,p%nTimeSteps), p%nTot, 'p%Forces' , ErrStat, ErrMsg); if (ErrStat /= 0) exit + call allocAry( p%times , max(1,p%nTimeSteps), 'p%times', ErrStat, ErrMsg); if (ErrStat /= 0) exit + if (p%nTimeSteps == 0) then + p%Forces= 0.0_ReKi + p%times = 0.0_ReKi + p%nTimeSteps = 1 + else + allocate(TmpAry(1:p%nTot+1)) + do i=1,p%nTimeSteps + iLine=iLine+1 + TmpAry(1:p%nTot+1)=-999.9E-09 + read(UnIn, fmt='(A)', iostat=ErrStat) Line + if (ErrStat/=0) then + ErrStat = ErrID_Fatal + ErrMSg='Failed to read line '//trim(Num2LStr(iLine))//' (out of '//trim(Num2LStr(p%nTimeSteps))//' expected lines) in file: '//trim(InputFile) + exit + end if + ! Extract fields (ReadR8AryFromStr is in NWTC_IO) + CALL ReadAry(Line, TmpAry, p%nTot+1, 'Forces', 'Forces', ErrStat, ErrMsg) + if (ErrStat/=0) then + ErrStat = ErrID_Fatal + ErrMsg='Failed to extract fields from line '//trim(Num2LStr(iLine))//'. '//trim(ErrMsg)//'. Check that the number of columns is correct in file: '//trim(InputFile) + exit + end if + if (ErrStat /= 0) exit + p%times(i) = TmpAry(1) + p%Forces(i,:) = TmpAry(2:p%nTot+1) + end do + end if + + elseif (index(Line,'!')==1) then + !write(*,*) 'Ignored comment: '//trim(Line) + else + ! Ignore unsupported lines + !write(*,*) 'Ignored line: '//trim(Line) + endif + enddo + close( UnIn ) + END SUBROUTINE ReadFlexASCII + + !> Reads a Guyan ASCII file + SUBROUTINE ReadGuyanASCII() + ! Guyan reduction has 6 DOF, 0 CB DOFs + p%nCB = 0 + p%nTot = 6 + ! Get an available unit number for the file. + CALL GetNewUnit( UnIn, ErrStat, ErrMsg ); if ( ErrStat /= 0 ) return + ! Open the Primary input file. + CALL OpenFInpFile ( UnIn, InputFile, ErrStat, ErrMsg ); if ( ErrStat /= 0 ) return + + !-------------------------- HEADER --------------------------------------------- + CALL ReadStr( UnIn, InputFile, Line, 'Header line', 'File Header: External Platform MCKF Matrices (line 1)', ErrStat, ErrMsg) + if ( ErrStat /= 0 ) return + !---------------------- MASS MATRIX -------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Mass Matrix', ErrStat, ErrMsg) + if ( ErrStat /= 0 ) return + CALL ReadRealMatrix(UnIn, InputFile, p%Mass, 'Mass Matrix', p%nTot, p%nTot, ErrStat, ErrMsg, iLine) + if ( ErrStat /= 0 ) return + !---------------------- DAMPING MATRIX -------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Damping Matrix', ErrStat, ErrMsg) + if ( ErrStat /= 0 ) return + CALL ReadRealMatrix(UnIn, InputFile, p%Damp, 'Damping Matrix', p%nTot, p%nTot, ErrStat, ErrMsg, iLine) + if ( ErrStat /= 0 ) return + !---------------------- STIFFNESS MATRIX -------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Stiffness Matrix', ErrStat, ErrMsg) + if ( ErrStat /= 0 ) return + CALL ReadRealMatrix(UnIn, InputFile, p%Stff, 'Stiffness Matrix', p%nTot, p%nTot, ErrStat, ErrMsg, iLine) + if ( ErrStat /= 0 ) return + !---------------------- LOAD time-history -------------------------------------- + p%nTimeSteps = 0 + CALL ReadCom( UnIn, InputFile, 'Section Header: Loads time-history', ErrStat, ErrMsg) + CALL ReadCom( UnIn, InputFile, 'Loads time-history table channel names', ErrStat, ErrMsg) + CALL ReadCom( UnIn, InputFile, 'Loads time-history table channel units', ErrStat, ErrMsg) + allocate(TmpAry(1:p%nTot+1)) + if (ErrStat < AbortErrLev) then + ! let's figure out how many rows of data are in the time-history table: + read( UnIn, *, IOSTAT=ErrStat ) TmpAry + do while (ErrStat==0) + p%nTimeSteps = p%nTimeSteps + 1 + read( UnIn, *, IOSTAT=ErrStat ) TmpAry + end do + end if + call allocAry( p%Forces, max(1,p%nTimeSteps), p%nTot, 'p%Forces', ErrStat, ErrMsg); if ( ErrStat /= 0 ) return + call allocAry( p%times , max(1,p%nTimeSteps), 'p%times' , ErrStat, ErrMsg); if ( ErrStat /= 0 ) return + if (p%nTimeSteps == 0) then + p%Forces = 0.0_ReKi + p%times = 0.0_ReKi + p%nTimeSteps = 1 + else + rewind(UnIn) + do i=1,25 ! skip the first 25 rows of the file until we get to the data for the time-history table + read(UnIn,*,IOSTAT=ErrStat) line + end do + do i=1,p%nTimeSteps + read(UnIn, fmt='(A)', iostat=ErrStat) Line + if (ErrStat/=0) then + ErrStat = ErrID_Fatal + ErrMSg='Failed to read line '//trim(Num2LStr(iLine))//' (out of '//trim(Num2LStr(p%nTimeSteps))//' expected lines) in file: '//trim(InputFile) + exit + end if + ! Extract fields (ReadR8AryFromStr is in NWTC_IO) + CALL ReadAry(Line, TmpAry, p%nTot+1, 'Forces', 'Forces', ErrStat, ErrMsg) + if (ErrStat/=0) then + ErrStat = ErrID_Fatal + ErrMsg='Failed to extract fields from line '//trim(Num2LStr(iLine))//'. '//trim(ErrMsg)//'. Check that the number of columns is correct in file: '//trim(InputFile) + exit + end if + if ( ErrStat /= 0 ) return + p%times(i) = TmpAry(1) + p%Forces(i,:) = TmpAry(2:p%nTot+1) + end do + end if + !---------------------- END OF FILE ----------------------------------------- + close( UnIn ) + END SUBROUTINE ReadGuyanASCII +END SUBROUTINE ReadReducedFile + +!> This routine generates the summary file, which contains a regurgitation of the input data and interpolated flexible body data. +SUBROUTINE ExtPtfm_PrintSum(x, p, m, RootName, ErrStat, ErrMsg) + ! passed variables + TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: x !< Initial continuous states + TYPE(ExtPtfm_ParameterType), INTENT(IN ) :: p !< Parameters of the structural dynamics module + TYPE(ExtPtfm_MiscVarType), INTENT(IN ) :: m !< Misc variables for optimization (not copied in glue code) + CHARACTER(*), INTENT(IN ) :: RootName !< Root Name to write the summary file + 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) :: UnSu ! I/O unit number for the summary output file +! CHARACTER(*), PARAMETER :: Fmt1 = "(34X,3(6X,'Blade',I2,:))" ! Format for outputting blade headings. +! CHARACTER(*), PARAMETER :: Fmt2 = "(34X,3(6X,A,:))" ! Format for outputting blade headings. +! CHARACTER(*), PARAMETER :: FmtDat = '(A,T35,3(:,F13.3))' ! Format for outputting mass and modal data. +! CHARACTER(*), PARAMETER :: FmtDatT = '(A,T35,1(:,F13.8))' ! Format for outputting time steps. + CHARACTER(30) :: OutPFmtS ! Format to print list of selected output channel names to summary file + CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file + CHARACTER(ChanLen),PARAMETER :: TitleStr(2) = (/ 'Parameter', 'Units ' /) + CHARACTER(ChanLen),PARAMETER :: TitleStrLines(2) = (/ '---------------', '---------------' /) + ErrStat = ErrID_None + ErrMsg = "" + ! TODO TODO TODO YAML FORMAT + ! TODO TODO TODO ONLY Open Summary if no optional unit given + + ! Open the summary file and give it a heading. + CALL GetNewUnit(UnSu, ErrStat, ErrMsg); + CALL OpenFOutFile(UnSu, TRIM( RootName )//'.sum', ErrStat, ErrMsg) + IF ( ErrStat /= ErrID_None ) RETURN + ! Heading: + WRITE (UnSu,'(/,A)') '!This summary information was generated by '//TRIM( GetNVD(ExtPtfm_Ver) )// & + ' on '//CurDate()//' at '//CurTime()//'.' + + write(UnSu,'(A)') '!Module input file' + write(UnSu,'(A,A)') 'Time integration method : ',StrIntMethod(p%IntMethod) + write(UnSu,'(A,F13.8)')'Integration time step : ',p%EP_DeltaT + write(UnSu,'(A)') '!Reduction input file' + write(UnSu,'(A,I0)') 'Number of time steps : ',p%nTimeSteps + write(UnSu,'(A,F13.8)')'Start time : ',p%times(1) + write(UnSu,'(A,F13.8)')'End time : ',p%times(p%nTimeSteps) + write(UnSu,'(A,I0)') 'Total number of DOF (input) : ',p%nCBFull+6 + write(UnSu,'(A,I0)') 'Number of CB modes (input) : ',p%nCBFull + write(UnSu,'(A)') '!Degrees of freedom' + write(UnSu,'(A,I0)') 'Total number of DOF (active) : ',p%nTot + write(UnSu,'(A,I0)') 'Number of CB modes (active) : ',p%nCB + call disp1i(UnSu, 'ActiveCBDOF',p%ActiveCBDOF) +! + if (m%EquilStart) then + write(UnSu,'(A)')'!Initial conditions (before equilibrium)' + else + write(UnSu,'(A)')'!Initial conditions (no equilibrium will be computed)' + endif + call disp1r8(UnSu, 'qm' ,x%qm) + call disp1r8(UnSu, 'qmdot',x%qmdot) + + write(UnSu,'(A)')'!State matrices' + call disp2r8(UnSu, 'A',p%AMat) + call disp2r8(UnSu, 'B',p%BMat) + call disp2r8(UnSu, 'C',p%CMat) + call disp2r8(UnSu, 'D',p%DMat) + write(UnSu,'(A)')'!Input matrices' + call disp2r8(UnSu, 'M',p%Mass) + call disp2r8(UnSu, 'K',p%Stff) + call disp2r8(UnSu, 'C',p%Damp) +! call disp2r8(UnSu, 'F',p%Forces) + write(UnSu,'(A)')'!Input sub-matrices' + call disp2r8(UnSu, 'M11',p%M11) + call disp2r8(UnSu, 'M12',p%M12) + call disp2r8(UnSu, 'M21',p%M21) + call disp2r8(UnSu, 'M22',p%M22) + call disp2r8(UnSu, 'K11',p%K11) + call disp2r8(UnSu, 'K22',p%K22) + call disp2r8(UnSu, 'C11',p%C11) + call disp2r8(UnSu, 'C12',p%C12) + call disp2r8(UnSu, 'C21',p%C21) + call disp2r8(UnSu, 'C22',p%C22) + + OutPFmt = '( I4, 3X,A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' + OutPFmtS = '( A4, 3X,A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' + write(UnSu,'(//,A,//)') '!Requested Outputs:' + 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 + + call cleanup() + +CONTAINS + !> + logical function Failed() + CALL SetErrStatSimple(ErrStat, ErrMsg, 'ExtPtfm_PrintSum') + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + !> + subroutine cleanup() + if (UnSu>0) close(UnSu) + end subroutine cleanup +END SUBROUTINE ExtPtfm_PrintSum + +END MODULE ExtPtfm_MCKF_IO diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt index 787d25e3ca..df8b051a81 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt +++ b/modules/extptfm/src/ExtPtfm_MCKF_Registry.txt @@ -17,19 +17,49 @@ include Registry_NWTC_Library.txt # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: # e.g., the name of the input file, the file root name, etc. -typedef ExtPtfm_MCKF/ExtPtfm InitInputType CHARACTER(1024) InputFile - - - "Name of the input file; remove if there is no file" - -typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -# note that I didn't add the RootName here. That would probably be a nice thing to have at some point.... +typedef ExtPtfm_MCKF/ExtPtfm InitInputType CHARACTER(1024) InputFile - - - "Name of the input file; remove if there is no file" - +typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ ReKi PtfmRefzt - - - "Vertical distance from the ground [onshore] or MSL [offshore] to the platform reference point" meters +typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" + +# ..... Input file data ........................................................................................................... +# This is data defined in the Input File for this module (or could otherwise be passed in) +# ..... Primary Input file data ........................................................................................................... +typedef ExtPtfm_MCKF/ExtPtfm ExtPtfm_InputFile DbKi DT - - - "Requested integration time for ElastoDyn" seconds +typedef ^ ^ IntKi IntMethod - - - "Integration Method (1=RK4, 2=AB4, 3=ABM4)" - +typedef ^ ^ IntKi FileFormat - - - "File format switch" - +typedef ^ ^ CHARACTER(1024) RedFile - - - "File containing reduction inputs" - +typedef ^ ^ CHARACTER(1024) RedFileCst - - - "File containing constant reduction inputs" - +typedef ^ ^ LOGICAL EquilStart - - - "Flag to determine the equilibrium positions of the CB modes at initialization (first call)" - +typedef ^ ^ IntKi ActiveCBDOF {:} - - "List of active CB DOF" - +typedef ^ ^ ReKi InitPosList {:} - - "Initial positions of the CB DOFs" - +typedef ^ ^ ReKi InitVelList {:} - - "Initial velocities of the CB DOFs" - +typedef ^ ^ LOGICAL SumPrint - - - "Print summary data to .sum" - +typedef ^ ^ IntKi OutFile - - - "Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both)" - +typedef ^ ^ LOGICAL TabDelim - - - "Flag to cause tab-delimited text output (delimited by space otherwise)" - +typedef ^ ^ CHARACTER(20) OutFmt - - - "Format used for module's text tabular output (except time); resulting field should be 10 characters" - +typedef ^ ^ DbKi Tstart - - - "Time to start module's tabular output" seconds +typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - + # Define outputs from the initialization routine here: -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: -typedef ^ ContinuousStateType ReKi DummyContState - - - "Remove this variable if you have continuous states" - +typedef ^ ContinuousStateType ReKi qm {:} - - "Internal CraigBampton positions" - +typedef ^ ContinuousStateType ReKi qmdot {:} - - "Internal CraigBampton velocities" - # Define discrete (nondifferentiable) states here: typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Remove this variable if you have discrete states" - @@ -38,30 +68,56 @@ typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Re typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - # Define any other states, including integer or logical states here: -typedef ^ OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - +typedef ^ OtherStateType ExtPtfm_ContinuousStateType xdot {:} - - "Previous state derivs for m-step time integrator" +typedef ^ ^ IntKi n - - - "Tracks time step for which OtherState was updated last" +#typedef ^ OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi q {6} - - "The 3 components of the translational displacement (in m) of the platform reference and the 3 components of the rotational displacement (in rad) of the platform relative to the inertial frame." "m, rad" -typedef ^ MiscVarType ReKi qdot {6} - - "The 3 components of the translational velocity (in m/s) of the platform reference and the 3 components of the rotational (angular) velocity (in rad/s) of the platform relative to the inertial frame." "m/s, rad/s" -typedef ^ MiscVarType ReKi qdotdot {6} - - "The 3 components of the translational acceleration (in m/s^2) of the platform reference and the 3 components of the rotational (angular) acceleration (in rad/s^2) of the platform relative to the inertial frame." "m/s^2, rad/s^2" -typedef ^ MiscVarType ReKi PtfmFt {6} - - "The 3 components of the portion of the platform force (in N) acting at the platform reference and the 3 components of the portion of the platform moment (in N-m) acting at the platform reference associated with everything but the added-mass effects; positive forces are in the direction of motion." "N, N-m" -typedef ^ MiscVarType ReKi F_PtfmAM {6} - - "Force/moment results calculated from the added mass and acceleration" -typedef ^ MiscVarType IntKi Indx - - - "Index into PtfmFt_t" - +typedef ^ MiscVarType ReKi xFlat {:} - - "Flattened vector of states" +typedef ^ MiscVarType ReKi uFlat {18} - - "Flattened vector of inputs" +typedef ^ MiscVarType ReKi F_at_t {:} - - "The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion)." "N, N-m" +typedef ^ MiscVarType IntKi Indx - - - "Index into times, to speed up interpolation" - +typedef ^ MiscVarType LOGICAL EquilStart - - - "Flag to determine the equilibrium position of the CB DOF at initialization (first call)" - +typedef ^ ^ ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType ReKi PtfmAM {6}{6} - - "Added mass matrix" "kg, kg-m, kg-m^2" -typedef ^ ParameterType ReKi Damp {6}{6} - - "Damping matrix" - -typedef ^ ParameterType ReKi Stff {6}{6} - - "Stiffness matrix" - -typedef ^ ParameterType ReKi PtfmFt {:}{:} - - "at each prescribed time step, the 3 components of the portion of the platform force (in N) acting at the platform reference and the 3 components of the portion of the platform moment (in N-m) acting at the platform reference associated with everything but the added-mass effects; positive forces are in the direction of motion." "N, N-m" -typedef ^ ParameterType ReKi PtfmFt_t {:} - - "the time associated with each row of PtfmFt" "s" -typedef ^ ParameterType IntKi nPtfmFt - - - "Number of values in PtfmFt_t" - -typedef ^ ParameterType IntKi NumOuts - - - "Number of values in WriteOutput" - +typedef ^ ParameterType ReKi Mass {:}{:} - - "Mass matrix" "kg, kg-m, kg-m^2" +typedef ^ ParameterType ReKi Damp {:}{:} - - "Damping matrix" - +typedef ^ ParameterType ReKi Stff {:}{:} - - "Stiffness matrix" - +typedef ^ ParameterType ReKi Forces {:}{:} - - "Prescribed reduced loads, the 3 platform forces (in N) and moments (Nm) acting at the platform reference, associated with everything but the added-mass effects; positive forces are in the direction of motion." "N, N-m" +typedef ^ ^ ReKi times {:} - - "the time associated with each row of Forces" "s" +typedef ^ ^ ReKi AMat {:}{:} - - "State matrix A" "" +typedef ^ ^ ReKi BMat {:}{:} - - "State matrix B" "" +typedef ^ ^ ReKi CMat {:}{:} - - "State matrix C" "" +typedef ^ ^ ReKi DMat {:}{:} - - "State matrix D" "" +typedef ^ ^ ReKi FX {:} - - "State constant Fx" "" +typedef ^ ^ ReKi FY {:} - - "Output constant Fy" "" +typedef ^ ^ ReKi M11 {:}{:} - - "Matrix M11" "" +typedef ^ ^ ReKi M12 {:}{:} - - "Matrix M12" "" +typedef ^ ^ ReKi M22 {:}{:} - - "Matrix M22" "" +typedef ^ ^ ReKi M21 {:}{:} - - "Matrix M21" "" +typedef ^ ^ ReKi K11 {:}{:} - - "Matrix K11" "" +typedef ^ ^ ReKi K22 {:}{:} - - "Matrix K22" "" +typedef ^ ^ ReKi C11 {:}{:} - - "Matrix C11" "" +typedef ^ ^ ReKi C12 {:}{:} - - "Matrix C12" "" +typedef ^ ^ ReKi C22 {:}{:} - - "Matrix C22" "" +typedef ^ ^ ReKi C21 {:}{:} - - "Matrix C21" "" +typedef ^ ^ DbKi EP_DeltaT - - - "Time step (for integration of continuous states)" "seconds" +typedef ^ ^ IntKi nTimeSteps - - - "Number of values of Forces and times" - +typedef ^ ^ IntKi nCB - - - "Number of CraigBampton modes active" - +typedef ^ ^ IntKi nCBFull - - - "Totla number of CraigBampton modes given as input" - +typedef ^ ^ IntKi nTot - - - "Total number of debrees of freedom (CB + interface)" - +typedef ^ ^ IntKi NumOuts - - - "Number of values in WriteOutput" - +typedef ^ ^ IntKi IntMethod - - - "Integration Method (1=RK4, 2=AB4, 3=ABM4)" - +typedef ^ ^ IntKi ActiveCBDOF {:} - - "List of active CB DOF" - +typedef ^ ^ OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ^ IntKi OutParamLinIndx {:}{:} - - "Index into WriteOutput for linearization analysis" - # ..... Inputs .................................................................................................................... typedef ^ InputType MeshType PtfmMesh - - - "Displacements at the platform reference point" - diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index d9e7df3e51..dcd7770cce 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -37,18 +37,48 @@ MODULE ExtPtfm_MCKF_Types TYPE, PUBLIC :: ExtPtfm_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground [onshore] or MSL [offshore] to the platform reference point [meters] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] END TYPE ExtPtfm_InitInputType ! ======================= +! ========= ExtPtfm_InputFile ======= + TYPE, PUBLIC :: ExtPtfm_InputFile + REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] + INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + INTEGER(IntKi) :: FileFormat !< File format switch [-] + CHARACTER(1024) :: RedFile !< File containing reduction inputs [-] + CHARACTER(1024) :: RedFileCst !< File containing constant reduction inputs [-] + LOGICAL :: EquilStart !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitPosList !< Initial positions of the CB DOFs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitVelList !< Initial velocities of the CB DOFs [-] + LOGICAL :: SumPrint !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] + REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + END TYPE ExtPtfm_InputFile +! ======================= ! ========= ExtPtfm_InitOutputType ======= TYPE, PUBLIC :: ExtPtfm_InitOutputType TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] END TYPE ExtPtfm_InitOutputType ! ======================= ! ========= ExtPtfm_ContinuousStateType ======= TYPE, PUBLIC :: ExtPtfm_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qm !< Internal CraigBampton positions [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdot !< Internal CraigBampton velocities [-] END TYPE ExtPtfm_ContinuousStateType ! ======================= ! ========= ExtPtfm_DiscreteStateType ======= @@ -63,28 +93,53 @@ MODULE ExtPtfm_MCKF_Types ! ======================= ! ========= ExtPtfm_OtherStateType ======= TYPE, PUBLIC :: ExtPtfm_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< Previous state derivs for m-step time integrator [-] + INTEGER(IntKi) :: n !< Tracks time step for which OtherState was updated last [-] END TYPE ExtPtfm_OtherStateType ! ======================= ! ========= ExtPtfm_MiscVarType ======= TYPE, PUBLIC :: ExtPtfm_MiscVarType - REAL(ReKi) , DIMENSION(1:6) :: q !< The 3 components of the translational displacement (in m) of the platform reference and the 3 components of the rotational displacement (in rad) of the platform relative to the inertial frame. [m, rad] - REAL(ReKi) , DIMENSION(1:6) :: qdot !< The 3 components of the translational velocity (in m/s) of the platform reference and the 3 components of the rotational (angular) velocity (in rad/s) of the platform relative to the inertial frame. [m/s, rad/s] - REAL(ReKi) , DIMENSION(1:6) :: qdotdot !< The 3 components of the translational acceleration (in m/s^2) of the platform reference and the 3 components of the rotational (angular) acceleration (in rad/s^2) of the platform relative to the inertial frame. [m/s^2, rad/s^2] - REAL(ReKi) , DIMENSION(1:6) :: PtfmFt !< The 3 components of the portion of the platform force (in N) acting at the platform reference and the 3 components of the portion of the platform moment (in N-m) acting at the platform reference associated with everything but the added-mass effects; positive forces are in the direction of motion. [N, N-m] - REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM !< Force/moment results calculated from the added mass and acceleration [-] - INTEGER(IntKi) :: Indx !< Index into PtfmFt_t [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] + REAL(ReKi) , DIMENSION(1:18) :: uFlat !< Flattened vector of inputs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] + INTEGER(IntKi) :: Indx !< Index into times, to speed up interpolation [-] + LOGICAL :: EquilStart !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] END TYPE ExtPtfm_MiscVarType ! ======================= ! ========= ExtPtfm_ParameterType ======= TYPE, PUBLIC :: ExtPtfm_ParameterType - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM !< Added mass matrix [kg, kg-m, kg-m^2] - REAL(ReKi) , DIMENSION(1:6,1:6) :: Damp !< Damping matrix [-] - REAL(ReKi) , DIMENSION(1:6,1:6) :: Stff !< Stiffness matrix [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmFt !< at each prescribed time step, the 3 components of the portion of the platform force (in N) acting at the platform reference and the 3 components of the portion of the platform moment (in N-m) acting at the platform reference associated with everything but the added-mass effects; positive forces are in the direction of motion. [N, N-m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmFt_t !< the time associated with each row of PtfmFt [s] - INTEGER(IntKi) :: nPtfmFt !< Number of values in PtfmFt_t [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mass !< Mass matrix [kg, kg-m, kg-m^2] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Damp !< Damping matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Stff !< Stiffness matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Forces !< Prescribed reduced loads, the 3 platform forces (in N) and moments (Nm) acting at the platform reference, associated with everything but the added-mass effects; positive forces are in the direction of motion. [N, N-m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: times !< the time associated with each row of Forces [s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AMat !< State matrix A [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BMat !< State matrix B [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMat !< State matrix C [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DMat !< State matrix D [] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FX !< State constant Fx [] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FY !< Output constant Fy [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M11 !< Matrix M11 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M12 !< Matrix M12 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M22 !< Matrix M22 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M21 !< Matrix M21 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: K11 !< Matrix K11 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: K22 !< Matrix K22 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C11 !< Matrix C11 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C12 !< Matrix C12 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C22 !< Matrix C22 [] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C21 !< Matrix C21 [] + REAL(DbKi) :: EP_DeltaT !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: nTimeSteps !< Number of values of Forces and times [-] + INTEGER(IntKi) :: nCB !< Number of CraigBampton modes active [-] + INTEGER(IntKi) :: nCBFull !< Totla number of CraigBampton modes given as input [-] + INTEGER(IntKi) :: nTot !< Total number of debrees of freedom (CB + interface) [-] INTEGER(IntKi) :: NumOuts !< Number of values in WriteOutput [-] + INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for linearization analysis [-] END TYPE ExtPtfm_ParameterType ! ======================= ! ========= ExtPtfm_InputType ======= @@ -117,6 +172,8 @@ SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrMsg = "" DstInitInputData%InputFile = SrcInitInputData%InputFile DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + DstInitInputData%RootName = SrcInitInputData%RootName END SUBROUTINE ExtPtfm_CopyInitInput SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -167,6 +224,8 @@ SUBROUTINE ExtPtfm_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = 0 Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile Int_BufSz = Int_BufSz + 1 ! Linearize + Re_BufSz = Re_BufSz + 1 ! PtfmRefzt + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -194,12 +253,18 @@ SUBROUTINE ExtPtfm_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ExtPtfm_PackInitInput SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -215,12 +280,6 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -236,17 +295,23 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ExtPtfm_UnPackInitInput - SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: DstInitOutputData + SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_InputFile), INTENT(IN) :: SrcInputFileData + TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: DstInputFileData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -255,62 +320,100 @@ SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInputFile' ! ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FileFormat = SrcInputFileData%FileFormat + DstInputFileData%RedFile = SrcInputFileData%RedFile + DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst + DstInputFileData%EquilStart = SrcInputFileData%EquilStart +IF (ALLOCATED(SrcInputFileData%ActiveCBDOF)) THEN + i1_l = LBOUND(SrcInputFileData%ActiveCBDOF,1) + i1_u = UBOUND(SrcInputFileData%ActiveCBDOF,1) + IF (.NOT. ALLOCATED(DstInputFileData%ActiveCBDOF)) THEN + ALLOCATE(DstInputFileData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF 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(SrcInputFileData%InitPosList)) THEN + i1_l = LBOUND(SrcInputFileData%InitPosList,1) + i1_u = UBOUND(SrcInputFileData%InitPosList,1) + IF (.NOT. ALLOCATED(DstInputFileData%InitPosList)) THEN + ALLOCATE(DstInputFileData%InitPosList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + DstInputFileData%InitPosList = SrcInputFileData%InitPosList ENDIF - END SUBROUTINE ExtPtfm_CopyInitOutput +IF (ALLOCATED(SrcInputFileData%InitVelList)) THEN + i1_l = LBOUND(SrcInputFileData%InitVelList,1) + i1_u = UBOUND(SrcInputFileData%InitVelList,1) + IF (.NOT. ALLOCATED(DstInputFileData%InitVelList)) THEN + ALLOCATE(DstInputFileData%InitVelList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%InitVelList = SrcInputFileData%InitVelList +ENDIF + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts +IF (ALLOCATED(SrcInputFileData%OutList)) THEN + i1_l = LBOUND(SrcInputFileData%OutList,1) + i1_u = UBOUND(SrcInputFileData%OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN + ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%OutList = SrcInputFileData%OutList +ENDIF + END SUBROUTINE ExtPtfm_CopyInputFile - SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: InitOutputData + SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInputFile' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) +IF (ALLOCATED(InputFileData%ActiveCBDOF)) THEN + DEALLOCATE(InputFileData%ActiveCBDOF) ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) +IF (ALLOCATED(InputFileData%InitPosList)) THEN + DEALLOCATE(InputFileData%InitPosList) ENDIF - END SUBROUTINE ExtPtfm_DestroyInitOutput +IF (ALLOCATED(InputFileData%InitVelList)) THEN + DEALLOCATE(InputFileData%InitVelList) +ENDIF +IF (ALLOCATED(InputFileData%OutList)) THEN + DEALLOCATE(InputFileData%OutList) +ENDIF + END SUBROUTINE ExtPtfm_DestroyInputFile - SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: InData + TYPE(ExtPtfm_InputFile), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -325,7 +428,7 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInputFile' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -341,33 +444,37 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + Db_BufSz = Db_BufSz + 1 ! DT + Int_BufSz = Int_BufSz + 1 ! IntMethod + Int_BufSz = Int_BufSz + 1 ! FileFormat + Int_BufSz = Int_BufSz + 1*LEN(InData%RedFile) ! RedFile + Int_BufSz = Int_BufSz + 1*LEN(InData%RedFileCst) ! RedFileCst + Int_BufSz = Int_BufSz + 1 ! EquilStart + Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no + IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF END IF - Int_BufSz = Int_BufSz + 1 ! 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 + Int_BufSz = Int_BufSz + 1 ! InitPosList allocated yes/no + IF ( ALLOCATED(InData%InitPosList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InitPosList upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%InitPosList) ! InitPosList + END IF + Int_BufSz = Int_BufSz + 1 ! InitVelList allocated yes/no + IF ( ALLOCATED(InData%InitVelList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InitVelList upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%InitVelList) ! InitVelList + END IF + Int_BufSz = Int_BufSz + 1 ! SumPrint + Int_BufSz = Int_BufSz + 1 ! OutFile + Int_BufSz = Int_BufSz + 1 ! TabDelim + Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt + Db_BufSz = Db_BufSz + 1 ! Tstart + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no + IF ( ALLOCATED(InData%OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -396,75 +503,105 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FileFormat + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RedFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%RedFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RedFileCst) + IntKiBuf(Int_Xferred) = ICHAR(InData%RedFileCst(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ActiveCBDOF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) + IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InitPosList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InitPosList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO i1 = LBOUND(InData%InitPosList,1), UBOUND(InData%InitPosList,1) + ReKiBuf(Re_Xferred) = InData%InitPosList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IF ( .NOT. ALLOCATED(InData%InitVelList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InitVelList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitVelList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%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 + DO i1 = LBOUND(InData%InitVelList,1), UBOUND(InData%InitVelList,1) + ReKiBuf(Re_Xferred) = InData%InitVelList(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - END SUBROUTINE ExtPtfm_PackInitOutput + END SUBROUTINE ExtPtfm_PackInputFile - SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: OutData + TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -473,16 +610,10 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInputFile' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -493,266 +624,284 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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 ) + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RedFile) + OutData%RedFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) + END DO ! I + DO I = 1, LEN(OutData%RedFileCst) + OutData%RedFileCst(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + END DO ! I + OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) + ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) + OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitPosList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InitPosList)) DEALLOCATE(OutData%InitPosList) + ALLOCATE(OutData%InitPosList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InitPosList,1), UBOUND(OutData%InitPosList,1) + OutData%InitPosList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitVelList not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InitVelList)) DEALLOCATE(OutData%InitVelList) + ALLOCATE(OutData%InitVelList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%InitVelList,1), UBOUND(OutData%InitVelList,1) + OutData%InitVelList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) + ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - END SUBROUTINE ExtPtfm_UnPackInitOutput + END SUBROUTINE ExtPtfm_UnPackInputFile - SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: DstContStateData + SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: DstInitOutputData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyContState' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInitOutput' ! ErrStat = ErrID_None ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE ExtPtfm_CopyContState - - SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyContState - - SUBROUTINE ExtPtfm_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN + ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_PackContState - - SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackContState - - SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ExtPtfm_CopyDiscState + 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 + END SUBROUTINE ExtPtfm_CopyInitOutput - SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DiscStateData + SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyDiscState' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitOutput' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyDiscState + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF +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 + END SUBROUTINE ExtPtfm_DestroyInitOutput - SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: InData + TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -767,7 +916,7 @@ SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackDiscState' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInitOutput' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -783,7 +932,69 @@ SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no + IF ( ALLOCATED(InData%LinNames_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no + IF ( ALLOCATED(InData%LinNames_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no + IF ( ALLOCATED(InData%LinNames_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no + IF ( ALLOCATED(InData%RotFrame_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no + IF ( ALLOCATED(InData%RotFrame_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no + IF ( ALLOCATED(InData%RotFrame_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -811,146 +1022,186 @@ SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_PackDiscState - - SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackDiscState + 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 - SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ExtPtfm_CopyConstrState + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyConstrState + 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 - SUBROUTINE ExtPtfm_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + 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 ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 ( Int_BufSz .GT. 0 ) 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 ( .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(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + 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 - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + 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 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_PackConstrState + 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 - SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtPtfm_PackInitOutput + + SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: OutData + TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -959,15 +1210,10 @@ SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackConstrState' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInitOutput' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -978,43 +1224,283 @@ SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackConstrState - - SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE ExtPtfm_CopyOtherState - - SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyOtherState + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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 - SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) + ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO I = 1, LEN(OutData%LinNames_y) + OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) + ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO I = 1, LEN(OutData%LinNames_x) + OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) + ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO I = 1, LEN(OutData%LinNames_u) + OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) + ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) + ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) + ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtPtfm_UnPackInitOutput + + SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcContStateData%qm)) THEN + i1_l = LBOUND(SrcContStateData%qm,1) + i1_u = UBOUND(SrcContStateData%qm,1) + IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN + ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%qm = SrcContStateData%qm +ENDIF +IF (ALLOCATED(SrcContStateData%qmdot)) THEN + i1_l = LBOUND(SrcContStateData%qmdot,1) + i1_u = UBOUND(SrcContStateData%qmdot,1) + IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN + ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%qmdot = SrcContStateData%qmdot +ENDIF + END SUBROUTINE ExtPtfm_CopyContState + + SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ContStateData%qm)) THEN + DEALLOCATE(ContStateData%qm) +ENDIF +IF (ALLOCATED(ContStateData%qmdot)) THEN + DEALLOCATE(ContStateData%qmdot) +ENDIF + END SUBROUTINE ExtPtfm_DestroyContState + + SUBROUTINE ExtPtfm_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: InData + TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1029,7 +1515,7 @@ SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackOtherState' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackContState' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1045,7 +1531,16 @@ SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState + Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no + IF ( ALLOCATED(InData%qm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%qm) ! qm + END IF + Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no + IF ( ALLOCATED(InData%qmdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%qmdot) ! qmdot + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1073,15 +1568,43 @@ SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_PackOtherState + IF ( .NOT. ALLOCATED(InData%qm) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) + ReKiBuf(Re_Xferred) = InData%qm(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) + ReKiBuf(Re_Xferred) = InData%qmdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtPtfm_PackContState + + SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OutData + TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -1090,15 +1613,10 @@ SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackOtherState' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackContState' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1109,49 +1627,77 @@ SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackOtherState + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%qm)) DEALLOCATE(OutData%qm) + ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) + OutData%qm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%qmdot)) DEALLOCATE(OutData%qmdot) + ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) + OutData%qmdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtPtfm_UnPackContState - SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: DstMiscData + SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyDiscState' ! ErrStat = ErrID_None ErrMsg = "" - DstMiscData%q = SrcMiscData%q - DstMiscData%qdot = SrcMiscData%qdot - DstMiscData%qdotdot = SrcMiscData%qdotdot - DstMiscData%PtfmFt = SrcMiscData%PtfmFt - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM - DstMiscData%Indx = SrcMiscData%Indx - END SUBROUTINE ExtPtfm_CopyMisc + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE ExtPtfm_CopyDiscState - SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: MiscData + SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyDiscState' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyMisc + END SUBROUTINE ExtPtfm_DestroyDiscState - SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: InData + TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1166,74 +1712,1934 @@ SUBROUTINE ExtPtfm_PackMisc( 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 = 'ExtPtfm_PackMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackDiscState' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%q) ! q - Re_BufSz = Re_BufSz + SIZE(InData%qdot) ! qdot - Re_BufSz = Re_BufSz + SIZE(InData%qdotdot) ! qdotdot - Re_BufSz = Re_BufSz + SIZE(InData%PtfmFt) ! PtfmFt - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - Int_BufSz = Int_BufSz + 1 ! Indx - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyDiscState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtPtfm_PackDiscState + + SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtPtfm_UnPackDiscState + + SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE ExtPtfm_CopyConstrState + + SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyConstrState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE ExtPtfm_DestroyConstrState + + SUBROUTINE ExtPtfm_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtPtfm_PackConstrState + + SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtPtfm_UnPackConstrState + + SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOtherStateData%xdot)) THEN + i1_l = LBOUND(SrcOtherStateData%xdot,1) + i1_u = UBOUND(SrcOtherStateData%xdot,1) + IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN + ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) + CALL ExtPtfm_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstOtherStateData%n = SrcOtherStateData%n + END SUBROUTINE ExtPtfm_CopyOtherState + + SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOtherState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OtherStateData%xdot)) THEN +DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) + CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(OtherStateData%xdot) +ENDIF + END SUBROUTINE ExtPtfm_DestroyOtherState + + SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no + IF ( ALLOCATED(InData%xdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xdot + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xdot + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xdot + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! n + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%xdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ExtPtfm_PackOtherState + + SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) + ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE ExtPtfm_UnPackOtherState + + SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscData%xFlat)) THEN + i1_l = LBOUND(SrcMiscData%xFlat,1) + i1_u = UBOUND(SrcMiscData%xFlat,1) + IF (.NOT. ALLOCATED(DstMiscData%xFlat)) THEN + ALLOCATE(DstMiscData%xFlat(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%xFlat = SrcMiscData%xFlat +ENDIF + DstMiscData%uFlat = SrcMiscData%uFlat +IF (ALLOCATED(SrcMiscData%F_at_t)) THEN + i1_l = LBOUND(SrcMiscData%F_at_t,1) + i1_u = UBOUND(SrcMiscData%F_at_t,1) + IF (.NOT. ALLOCATED(DstMiscData%F_at_t)) THEN + ALLOCATE(DstMiscData%F_at_t(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%F_at_t = SrcMiscData%F_at_t +ENDIF + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%EquilStart = SrcMiscData%EquilStart +IF (ALLOCATED(SrcMiscData%AllOuts)) THEN + i1_l = LBOUND(SrcMiscData%AllOuts,1) + i1_u = UBOUND(SrcMiscData%AllOuts,1) + IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN + ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%AllOuts = SrcMiscData%AllOuts +ENDIF + END SUBROUTINE ExtPtfm_CopyMisc + + SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscData%xFlat)) THEN + DEALLOCATE(MiscData%xFlat) +ENDIF +IF (ALLOCATED(MiscData%F_at_t)) THEN + DEALLOCATE(MiscData%F_at_t) +ENDIF +IF (ALLOCATED(MiscData%AllOuts)) THEN + DEALLOCATE(MiscData%AllOuts) +ENDIF + END SUBROUTINE ExtPtfm_DestroyMisc + + SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! xFlat allocated yes/no + IF ( ALLOCATED(InData%xFlat) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xFlat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%xFlat) ! xFlat + END IF + Re_BufSz = Re_BufSz + SIZE(InData%uFlat) ! uFlat + Int_BufSz = Int_BufSz + 1 ! F_at_t allocated yes/no + IF ( ALLOCATED(InData%F_at_t) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! F_at_t upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%F_at_t) ! F_at_t + END IF + Int_BufSz = Int_BufSz + 1 ! Indx + Int_BufSz = Int_BufSz + 1 ! EquilStart + Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no + IF ( ALLOCATED(InData%AllOuts) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%xFlat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xFlat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xFlat,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xFlat,1), UBOUND(InData%xFlat,1) + ReKiBuf(Re_Xferred) = InData%xFlat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + DO i1 = LBOUND(InData%uFlat,1), UBOUND(InData%uFlat,1) + ReKiBuf(Re_Xferred) = InData%uFlat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%F_at_t) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%F_at_t,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_at_t,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%F_at_t,1), UBOUND(InData%F_at_t,1) + ReKiBuf(Re_Xferred) = InData%F_at_t(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtPtfm_PackMisc + + SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xFlat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xFlat)) DEALLOCATE(OutData%xFlat) + ALLOCATE(OutData%xFlat(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xFlat,1), UBOUND(OutData%xFlat,1) + OutData%xFlat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + i1_l = LBOUND(OutData%uFlat,1) + i1_u = UBOUND(OutData%uFlat,1) + DO i1 = LBOUND(OutData%uFlat,1), UBOUND(OutData%uFlat,1) + OutData%uFlat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_at_t not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%F_at_t)) DEALLOCATE(OutData%F_at_t) + ALLOCATE(OutData%F_at_t(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%F_at_t,1), UBOUND(OutData%F_at_t,1) + OutData%F_at_t(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) + ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtPtfm_UnPackMisc + + SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_ParameterType), INTENT(IN) :: SrcParamData + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcParamData%Mass)) THEN + i1_l = LBOUND(SrcParamData%Mass,1) + i1_u = UBOUND(SrcParamData%Mass,1) + i2_l = LBOUND(SrcParamData%Mass,2) + i2_u = UBOUND(SrcParamData%Mass,2) + IF (.NOT. ALLOCATED(DstParamData%Mass)) THEN + ALLOCATE(DstParamData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Mass = SrcParamData%Mass +ENDIF +IF (ALLOCATED(SrcParamData%Damp)) THEN + i1_l = LBOUND(SrcParamData%Damp,1) + i1_u = UBOUND(SrcParamData%Damp,1) + i2_l = LBOUND(SrcParamData%Damp,2) + i2_u = UBOUND(SrcParamData%Damp,2) + IF (.NOT. ALLOCATED(DstParamData%Damp)) THEN + ALLOCATE(DstParamData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Damp = SrcParamData%Damp +ENDIF +IF (ALLOCATED(SrcParamData%Stff)) THEN + i1_l = LBOUND(SrcParamData%Stff,1) + i1_u = UBOUND(SrcParamData%Stff,1) + i2_l = LBOUND(SrcParamData%Stff,2) + i2_u = UBOUND(SrcParamData%Stff,2) + IF (.NOT. ALLOCATED(DstParamData%Stff)) THEN + ALLOCATE(DstParamData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Stff = SrcParamData%Stff +ENDIF +IF (ALLOCATED(SrcParamData%Forces)) THEN + i1_l = LBOUND(SrcParamData%Forces,1) + i1_u = UBOUND(SrcParamData%Forces,1) + i2_l = LBOUND(SrcParamData%Forces,2) + i2_u = UBOUND(SrcParamData%Forces,2) + IF (.NOT. ALLOCATED(DstParamData%Forces)) THEN + ALLOCATE(DstParamData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Forces = SrcParamData%Forces +ENDIF +IF (ALLOCATED(SrcParamData%times)) THEN + i1_l = LBOUND(SrcParamData%times,1) + i1_u = UBOUND(SrcParamData%times,1) + IF (.NOT. ALLOCATED(DstParamData%times)) THEN + ALLOCATE(DstParamData%times(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%times = SrcParamData%times +ENDIF +IF (ALLOCATED(SrcParamData%AMat)) THEN + i1_l = LBOUND(SrcParamData%AMat,1) + i1_u = UBOUND(SrcParamData%AMat,1) + i2_l = LBOUND(SrcParamData%AMat,2) + i2_u = UBOUND(SrcParamData%AMat,2) + IF (.NOT. ALLOCATED(DstParamData%AMat)) THEN + ALLOCATE(DstParamData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AMat = SrcParamData%AMat +ENDIF +IF (ALLOCATED(SrcParamData%BMat)) THEN + i1_l = LBOUND(SrcParamData%BMat,1) + i1_u = UBOUND(SrcParamData%BMat,1) + i2_l = LBOUND(SrcParamData%BMat,2) + i2_u = UBOUND(SrcParamData%BMat,2) + IF (.NOT. ALLOCATED(DstParamData%BMat)) THEN + ALLOCATE(DstParamData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BMat = SrcParamData%BMat +ENDIF +IF (ALLOCATED(SrcParamData%CMat)) THEN + i1_l = LBOUND(SrcParamData%CMat,1) + i1_u = UBOUND(SrcParamData%CMat,1) + i2_l = LBOUND(SrcParamData%CMat,2) + i2_u = UBOUND(SrcParamData%CMat,2) + IF (.NOT. ALLOCATED(DstParamData%CMat)) THEN + ALLOCATE(DstParamData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CMat = SrcParamData%CMat +ENDIF +IF (ALLOCATED(SrcParamData%DMat)) THEN + i1_l = LBOUND(SrcParamData%DMat,1) + i1_u = UBOUND(SrcParamData%DMat,1) + i2_l = LBOUND(SrcParamData%DMat,2) + i2_u = UBOUND(SrcParamData%DMat,2) + IF (.NOT. ALLOCATED(DstParamData%DMat)) THEN + ALLOCATE(DstParamData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%DMat = SrcParamData%DMat +ENDIF +IF (ALLOCATED(SrcParamData%FX)) THEN + i1_l = LBOUND(SrcParamData%FX,1) + i1_u = UBOUND(SrcParamData%FX,1) + IF (.NOT. ALLOCATED(DstParamData%FX)) THEN + ALLOCATE(DstParamData%FX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%FX = SrcParamData%FX +ENDIF +IF (ALLOCATED(SrcParamData%FY)) THEN + i1_l = LBOUND(SrcParamData%FY,1) + i1_u = UBOUND(SrcParamData%FY,1) + IF (.NOT. ALLOCATED(DstParamData%FY)) THEN + ALLOCATE(DstParamData%FY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%FY = SrcParamData%FY +ENDIF +IF (ALLOCATED(SrcParamData%M11)) THEN + i1_l = LBOUND(SrcParamData%M11,1) + i1_u = UBOUND(SrcParamData%M11,1) + i2_l = LBOUND(SrcParamData%M11,2) + i2_u = UBOUND(SrcParamData%M11,2) + IF (.NOT. ALLOCATED(DstParamData%M11)) THEN + ALLOCATE(DstParamData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%M11 = SrcParamData%M11 +ENDIF +IF (ALLOCATED(SrcParamData%M12)) THEN + i1_l = LBOUND(SrcParamData%M12,1) + i1_u = UBOUND(SrcParamData%M12,1) + i2_l = LBOUND(SrcParamData%M12,2) + i2_u = UBOUND(SrcParamData%M12,2) + IF (.NOT. ALLOCATED(DstParamData%M12)) THEN + ALLOCATE(DstParamData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%M12 = SrcParamData%M12 +ENDIF +IF (ALLOCATED(SrcParamData%M22)) THEN + i1_l = LBOUND(SrcParamData%M22,1) + i1_u = UBOUND(SrcParamData%M22,1) + i2_l = LBOUND(SrcParamData%M22,2) + i2_u = UBOUND(SrcParamData%M22,2) + IF (.NOT. ALLOCATED(DstParamData%M22)) THEN + ALLOCATE(DstParamData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%M22 = SrcParamData%M22 +ENDIF +IF (ALLOCATED(SrcParamData%M21)) THEN + i1_l = LBOUND(SrcParamData%M21,1) + i1_u = UBOUND(SrcParamData%M21,1) + i2_l = LBOUND(SrcParamData%M21,2) + i2_u = UBOUND(SrcParamData%M21,2) + IF (.NOT. ALLOCATED(DstParamData%M21)) THEN + ALLOCATE(DstParamData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%M21 = SrcParamData%M21 +ENDIF +IF (ALLOCATED(SrcParamData%K11)) THEN + i1_l = LBOUND(SrcParamData%K11,1) + i1_u = UBOUND(SrcParamData%K11,1) + i2_l = LBOUND(SrcParamData%K11,2) + i2_u = UBOUND(SrcParamData%K11,2) + IF (.NOT. ALLOCATED(DstParamData%K11)) THEN + ALLOCATE(DstParamData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%K11 = SrcParamData%K11 +ENDIF +IF (ALLOCATED(SrcParamData%K22)) THEN + i1_l = LBOUND(SrcParamData%K22,1) + i1_u = UBOUND(SrcParamData%K22,1) + i2_l = LBOUND(SrcParamData%K22,2) + i2_u = UBOUND(SrcParamData%K22,2) + IF (.NOT. ALLOCATED(DstParamData%K22)) THEN + ALLOCATE(DstParamData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%K22 = SrcParamData%K22 +ENDIF +IF (ALLOCATED(SrcParamData%C11)) THEN + i1_l = LBOUND(SrcParamData%C11,1) + i1_u = UBOUND(SrcParamData%C11,1) + i2_l = LBOUND(SrcParamData%C11,2) + i2_u = UBOUND(SrcParamData%C11,2) + IF (.NOT. ALLOCATED(DstParamData%C11)) THEN + ALLOCATE(DstParamData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C11 = SrcParamData%C11 +ENDIF +IF (ALLOCATED(SrcParamData%C12)) THEN + i1_l = LBOUND(SrcParamData%C12,1) + i1_u = UBOUND(SrcParamData%C12,1) + i2_l = LBOUND(SrcParamData%C12,2) + i2_u = UBOUND(SrcParamData%C12,2) + IF (.NOT. ALLOCATED(DstParamData%C12)) THEN + ALLOCATE(DstParamData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C12 = SrcParamData%C12 +ENDIF +IF (ALLOCATED(SrcParamData%C22)) THEN + i1_l = LBOUND(SrcParamData%C22,1) + i1_u = UBOUND(SrcParamData%C22,1) + i2_l = LBOUND(SrcParamData%C22,2) + i2_u = UBOUND(SrcParamData%C22,2) + IF (.NOT. ALLOCATED(DstParamData%C22)) THEN + ALLOCATE(DstParamData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C22 = SrcParamData%C22 +ENDIF +IF (ALLOCATED(SrcParamData%C21)) THEN + i1_l = LBOUND(SrcParamData%C21,1) + i1_u = UBOUND(SrcParamData%C21,1) + i2_l = LBOUND(SrcParamData%C21,2) + i2_u = UBOUND(SrcParamData%C21,2) + IF (.NOT. ALLOCATED(DstParamData%C21)) THEN + ALLOCATE(DstParamData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C21 = SrcParamData%C21 +ENDIF + DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT + DstParamData%nTimeSteps = SrcParamData%nTimeSteps + DstParamData%nCB = SrcParamData%nCB + DstParamData%nCBFull = SrcParamData%nCBFull + DstParamData%nTot = SrcParamData%nTot + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%IntMethod = SrcParamData%IntMethod +IF (ALLOCATED(SrcParamData%ActiveCBDOF)) THEN + i1_l = LBOUND(SrcParamData%ActiveCBDOF,1) + i1_u = UBOUND(SrcParamData%ActiveCBDOF,1) + IF (.NOT. ALLOCATED(DstParamData%ActiveCBDOF)) THEN + ALLOCATE(DstParamData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF +ENDIF +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN + i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) + i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) + i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) + i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) + IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN + ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx +ENDIF + END SUBROUTINE ExtPtfm_CopyParam + + SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyParam' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ParamData%Mass)) THEN + DEALLOCATE(ParamData%Mass) +ENDIF +IF (ALLOCATED(ParamData%Damp)) THEN + DEALLOCATE(ParamData%Damp) +ENDIF +IF (ALLOCATED(ParamData%Stff)) THEN + DEALLOCATE(ParamData%Stff) +ENDIF +IF (ALLOCATED(ParamData%Forces)) THEN + DEALLOCATE(ParamData%Forces) +ENDIF +IF (ALLOCATED(ParamData%times)) THEN + DEALLOCATE(ParamData%times) +ENDIF +IF (ALLOCATED(ParamData%AMat)) THEN + DEALLOCATE(ParamData%AMat) +ENDIF +IF (ALLOCATED(ParamData%BMat)) THEN + DEALLOCATE(ParamData%BMat) +ENDIF +IF (ALLOCATED(ParamData%CMat)) THEN + DEALLOCATE(ParamData%CMat) +ENDIF +IF (ALLOCATED(ParamData%DMat)) THEN + DEALLOCATE(ParamData%DMat) +ENDIF +IF (ALLOCATED(ParamData%FX)) THEN + DEALLOCATE(ParamData%FX) +ENDIF +IF (ALLOCATED(ParamData%FY)) THEN + DEALLOCATE(ParamData%FY) +ENDIF +IF (ALLOCATED(ParamData%M11)) THEN + DEALLOCATE(ParamData%M11) +ENDIF +IF (ALLOCATED(ParamData%M12)) THEN + DEALLOCATE(ParamData%M12) +ENDIF +IF (ALLOCATED(ParamData%M22)) THEN + DEALLOCATE(ParamData%M22) +ENDIF +IF (ALLOCATED(ParamData%M21)) THEN + DEALLOCATE(ParamData%M21) +ENDIF +IF (ALLOCATED(ParamData%K11)) THEN + DEALLOCATE(ParamData%K11) +ENDIF +IF (ALLOCATED(ParamData%K22)) THEN + DEALLOCATE(ParamData%K22) +ENDIF +IF (ALLOCATED(ParamData%C11)) THEN + DEALLOCATE(ParamData%C11) +ENDIF +IF (ALLOCATED(ParamData%C12)) THEN + DEALLOCATE(ParamData%C12) +ENDIF +IF (ALLOCATED(ParamData%C22)) THEN + DEALLOCATE(ParamData%C22) +ENDIF +IF (ALLOCATED(ParamData%C21)) THEN + DEALLOCATE(ParamData%C21) +ENDIF +IF (ALLOCATED(ParamData%ActiveCBDOF)) THEN + DEALLOCATE(ParamData%ActiveCBDOF) +ENDIF +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN + DEALLOCATE(ParamData%OutParamLinIndx) +ENDIF + END SUBROUTINE ExtPtfm_DestroyParam + + SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ExtPtfm_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Mass allocated yes/no + IF ( ALLOCATED(InData%Mass) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Mass upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Mass) ! Mass + END IF + Int_BufSz = Int_BufSz + 1 ! Damp allocated yes/no + IF ( ALLOCATED(InData%Damp) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Damp upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Damp) ! Damp + END IF + Int_BufSz = Int_BufSz + 1 ! Stff allocated yes/no + IF ( ALLOCATED(InData%Stff) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Stff upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Stff) ! Stff + END IF + Int_BufSz = Int_BufSz + 1 ! Forces allocated yes/no + IF ( ALLOCATED(InData%Forces) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Forces upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Forces) ! Forces + END IF + Int_BufSz = Int_BufSz + 1 ! times allocated yes/no + IF ( ALLOCATED(InData%times) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! times upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%times) ! times + END IF + Int_BufSz = Int_BufSz + 1 ! AMat allocated yes/no + IF ( ALLOCATED(InData%AMat) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AMat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AMat) ! AMat + END IF + Int_BufSz = Int_BufSz + 1 ! BMat allocated yes/no + IF ( ALLOCATED(InData%BMat) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BMat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BMat) ! BMat + END IF + Int_BufSz = Int_BufSz + 1 ! CMat allocated yes/no + IF ( ALLOCATED(InData%CMat) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CMat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CMat) ! CMat + END IF + Int_BufSz = Int_BufSz + 1 ! DMat allocated yes/no + IF ( ALLOCATED(InData%DMat) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! DMat upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%DMat) ! DMat + END IF + Int_BufSz = Int_BufSz + 1 ! FX allocated yes/no + IF ( ALLOCATED(InData%FX) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FX upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%FX) ! FX + END IF + Int_BufSz = Int_BufSz + 1 ! FY allocated yes/no + IF ( ALLOCATED(InData%FY) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FY upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%FY) ! FY + END IF + Int_BufSz = Int_BufSz + 1 ! M11 allocated yes/no + IF ( ALLOCATED(InData%M11) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! M11 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%M11) ! M11 + END IF + Int_BufSz = Int_BufSz + 1 ! M12 allocated yes/no + IF ( ALLOCATED(InData%M12) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! M12 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%M12) ! M12 + END IF + Int_BufSz = Int_BufSz + 1 ! M22 allocated yes/no + IF ( ALLOCATED(InData%M22) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! M22 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%M22) ! M22 + END IF + Int_BufSz = Int_BufSz + 1 ! M21 allocated yes/no + IF ( ALLOCATED(InData%M21) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! M21 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%M21) ! M21 + END IF + Int_BufSz = Int_BufSz + 1 ! K11 allocated yes/no + IF ( ALLOCATED(InData%K11) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! K11 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%K11) ! K11 + END IF + Int_BufSz = Int_BufSz + 1 ! K22 allocated yes/no + IF ( ALLOCATED(InData%K22) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! K22 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%K22) ! K22 + END IF + Int_BufSz = Int_BufSz + 1 ! C11 allocated yes/no + IF ( ALLOCATED(InData%C11) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C11 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C11) ! C11 + END IF + Int_BufSz = Int_BufSz + 1 ! C12 allocated yes/no + IF ( ALLOCATED(InData%C12) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C12 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C12) ! C12 + END IF + Int_BufSz = Int_BufSz + 1 ! C22 allocated yes/no + IF ( ALLOCATED(InData%C22) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C22 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C22) ! C22 + END IF + Int_BufSz = Int_BufSz + 1 ! C21 allocated yes/no + IF ( ALLOCATED(InData%C21) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C21 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C21) ! C21 + END IF + Db_BufSz = Db_BufSz + 1 ! EP_DeltaT + Int_BufSz = Int_BufSz + 1 ! nTimeSteps + Int_BufSz = Int_BufSz + 1 ! nCB + Int_BufSz = Int_BufSz + 1 ! nCBFull + Int_BufSz = Int_BufSz + 1 ! nTot + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! IntMethod + Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no + IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF + END IF + Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no + IF ( ALLOCATED(InData%OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OutParamLinIndx allocated yes/no + IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%Mass) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Mass,2), UBOUND(InData%Mass,2) + DO i1 = LBOUND(InData%Mass,1), UBOUND(InData%Mass,1) + ReKiBuf(Re_Xferred) = InData%Mass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Damp) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Damp,2), UBOUND(InData%Damp,2) + DO i1 = LBOUND(InData%Damp,1), UBOUND(InData%Damp,1) + ReKiBuf(Re_Xferred) = InData%Damp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Stff) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Stff,2), UBOUND(InData%Stff,2) + DO i1 = LBOUND(InData%Stff,1), UBOUND(InData%Stff,1) + ReKiBuf(Re_Xferred) = InData%Stff(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Forces) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Forces,2), UBOUND(InData%Forces,2) + DO i1 = LBOUND(InData%Forces,1), UBOUND(InData%Forces,1) + ReKiBuf(Re_Xferred) = InData%Forces(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%times) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%times,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%times,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%times,1), UBOUND(InData%times,1) + ReKiBuf(Re_Xferred) = InData%times(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AMat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AMat,2), UBOUND(InData%AMat,2) + DO i1 = LBOUND(InData%AMat,1), UBOUND(InData%AMat,1) + ReKiBuf(Re_Xferred) = InData%AMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BMat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BMat,2), UBOUND(InData%BMat,2) + DO i1 = LBOUND(InData%BMat,1), UBOUND(InData%BMat,1) + ReKiBuf(Re_Xferred) = InData%BMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CMat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CMat,2), UBOUND(InData%CMat,2) + DO i1 = LBOUND(InData%CMat,1), UBOUND(InData%CMat,1) + ReKiBuf(Re_Xferred) = InData%CMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DMat) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%DMat,2), UBOUND(InData%DMat,2) + DO i1 = LBOUND(InData%DMat,1), UBOUND(InData%DMat,1) + ReKiBuf(Re_Xferred) = InData%DMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FX) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FX,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) + ReKiBuf(Re_Xferred) = InData%FX(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FY) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FY,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FY,1), UBOUND(InData%FY,1) + ReKiBuf(Re_Xferred) = InData%FY(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%M11) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%M11,2), UBOUND(InData%M11,2) + DO i1 = LBOUND(InData%M11,1), UBOUND(InData%M11,1) + ReKiBuf(Re_Xferred) = InData%M11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%M12) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%M12,2), UBOUND(InData%M12,2) + DO i1 = LBOUND(InData%M12,1), UBOUND(InData%M12,1) + ReKiBuf(Re_Xferred) = InData%M12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%M22) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%M22,2), UBOUND(InData%M22,2) + DO i1 = LBOUND(InData%M22,1), UBOUND(InData%M22,1) + ReKiBuf(Re_Xferred) = InData%M22(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%M21) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%M21,2), UBOUND(InData%M21,2) + DO i1 = LBOUND(InData%M21,1), UBOUND(InData%M21,1) + ReKiBuf(Re_Xferred) = InData%M21(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%K11) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%K11,2), UBOUND(InData%K11,2) + DO i1 = LBOUND(InData%K11,1), UBOUND(InData%K11,1) + ReKiBuf(Re_Xferred) = InData%K11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%K22) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%K22,2), UBOUND(InData%K22,2) + DO i1 = LBOUND(InData%K22,1), UBOUND(InData%K22,1) + ReKiBuf(Re_Xferred) = InData%K22(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C11) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C11,2), UBOUND(InData%C11,2) + DO i1 = LBOUND(InData%C11,1), UBOUND(InData%C11,1) + ReKiBuf(Re_Xferred) = InData%C11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C12) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C12,2), UBOUND(InData%C12,2) + DO i1 = LBOUND(InData%C12,1), UBOUND(InData%C12,1) + ReKiBuf(Re_Xferred) = InData%C12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C22) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C22,2), UBOUND(InData%C22,2) + DO i1 = LBOUND(InData%C22,1), UBOUND(InData%C22,1) + ReKiBuf(Re_Xferred) = InData%C22(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%C21) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C21,2), UBOUND(InData%C21,2) + DO i1 = LBOUND(InData%C21,1), UBOUND(InData%C21,1) + ReKiBuf(Re_Xferred) = InData%C21(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DbKiBuf(Db_Xferred) = InData%EP_DeltaT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nTimeSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nCB + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nCBFull + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nTot + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ActiveCBDOF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) + IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + 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 - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qdot))-1 ) = PACK(InData%qdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qdot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qdotdot))-1 ) = PACK(InData%qdotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qdotdot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_PackMisc + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) + DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) + IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE ExtPtfm_PackParam + + SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: OutData + TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -1242,16 +3648,11 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackParam' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1262,323 +3663,452 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%q,1) - i1_u = UBOUND(OutData%q,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Mass)) DEALLOCATE(OutData%Mass) + ALLOCATE(OutData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%q = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%qdot,1) - i1_u = UBOUND(OutData%qdot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%Mass,2), UBOUND(OutData%Mass,2) + DO i1 = LBOUND(OutData%Mass,1), UBOUND(OutData%Mass,1) + OutData%Mass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Damp not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Damp)) DEALLOCATE(OutData%Damp) + ALLOCATE(OutData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%qdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qdot) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%qdotdot,1) - i1_u = UBOUND(OutData%qdotdot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%Damp,2), UBOUND(OutData%Damp,2) + DO i1 = LBOUND(OutData%Damp,1), UBOUND(OutData%Damp,1) + OutData%Damp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stff not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Stff)) DEALLOCATE(OutData%Stff) + ALLOCATE(OutData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%qdotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qdotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qdotdot) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%PtfmFt,1) - i1_u = UBOUND(OutData%PtfmFt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%Stff,2), UBOUND(OutData%Stff,2) + DO i1 = LBOUND(OutData%Stff,1), UBOUND(OutData%Stff,1) + OutData%Stff(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Forces not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Forces)) DEALLOCATE(OutData%Forces) + ALLOCATE(OutData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%F_PtfmAM,1) - i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%Forces,2), UBOUND(OutData%Forces,2) + DO i1 = LBOUND(OutData%Forces,1), UBOUND(OutData%Forces,1) + OutData%Forces(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! times not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%times)) DEALLOCATE(OutData%times) + ALLOCATE(OutData%times(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackMisc - - SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%PtfmAM = SrcParamData%PtfmAM - DstParamData%Damp = SrcParamData%Damp - DstParamData%Stff = SrcParamData%Stff -IF (ALLOCATED(SrcParamData%PtfmFt)) THEN - i1_l = LBOUND(SrcParamData%PtfmFt,1) - i1_u = UBOUND(SrcParamData%PtfmFt,1) - i2_l = LBOUND(SrcParamData%PtfmFt,2) - i2_u = UBOUND(SrcParamData%PtfmFt,2) - IF (.NOT. ALLOCATED(DstParamData%PtfmFt)) THEN - ALLOCATE(DstParamData%PtfmFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PtfmFt.', ErrStat, ErrMsg,RoutineName) - RETURN + DO i1 = LBOUND(OutData%times,1), UBOUND(OutData%times,1) + OutData%times(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AMat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AMat)) DEALLOCATE(OutData%AMat) + ALLOCATE(OutData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + DO i2 = LBOUND(OutData%AMat,2), UBOUND(OutData%AMat,2) + DO i1 = LBOUND(OutData%AMat,1), UBOUND(OutData%AMat,1) + OutData%AMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DstParamData%PtfmFt = SrcParamData%PtfmFt -ENDIF -IF (ALLOCATED(SrcParamData%PtfmFt_t)) THEN - i1_l = LBOUND(SrcParamData%PtfmFt_t,1) - i1_u = UBOUND(SrcParamData%PtfmFt_t,1) - IF (.NOT. ALLOCATED(DstParamData%PtfmFt_t)) THEN - ALLOCATE(DstParamData%PtfmFt_t(i1_l:i1_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BMat)) DEALLOCATE(OutData%BMat) + ALLOCATE(OutData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PtfmFt_t.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + DO i2 = LBOUND(OutData%BMat,2), UBOUND(OutData%BMat,2) + DO i1 = LBOUND(OutData%BMat,1), UBOUND(OutData%BMat,1) + OutData%BMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DstParamData%PtfmFt_t = SrcParamData%PtfmFt_t -ENDIF - DstParamData%nPtfmFt = SrcParamData%nPtfmFt - DstParamData%NumOuts = SrcParamData%NumOuts - END SUBROUTINE ExtPtfm_CopyParam - - SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%PtfmFt)) THEN - DEALLOCATE(ParamData%PtfmFt) -ENDIF -IF (ALLOCATED(ParamData%PtfmFt_t)) THEN - DEALLOCATE(ParamData%PtfmFt_t) -ENDIF - END SUBROUTINE ExtPtfm_DestroyParam - - SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%PtfmAM) ! PtfmAM - Re_BufSz = Re_BufSz + SIZE(InData%Damp) ! Damp - Re_BufSz = Re_BufSz + SIZE(InData%Stff) ! Stff - Int_BufSz = Int_BufSz + 1 ! PtfmFt allocated yes/no - IF ( ALLOCATED(InData%PtfmFt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtfmFt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmFt) ! PtfmFt + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CMat)) DEALLOCATE(OutData%CMat) + ALLOCATE(OutData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CMat,2), UBOUND(OutData%CMat,2) + DO i1 = LBOUND(OutData%CMat,1), UBOUND(OutData%CMat,1) + OutData%CMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - Int_BufSz = Int_BufSz + 1 ! PtfmFt_t allocated yes/no - IF ( ALLOCATED(InData%PtfmFt_t) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmFt_t upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmFt_t) ! PtfmFt_t + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DMat not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DMat)) DEALLOCATE(OutData%DMat) + ALLOCATE(OutData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%DMat,2), UBOUND(OutData%DMat,2) + DO i1 = LBOUND(OutData%DMat,1), UBOUND(OutData%DMat,1) + OutData%DMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - Int_BufSz = Int_BufSz + 1 ! nPtfmFt - Int_BufSz = Int_BufSz + 1 ! NumOuts - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FX)) DEALLOCATE(OutData%FX) + ALLOCATE(OutData%FX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) + OutData%FX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( Db_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 ! FY not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FY)) DEALLOCATE(OutData%FY) + ALLOCATE(OutData%FY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) + OutData%FY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( Int_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 ! M11 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%M11)) DEALLOCATE(OutData%M11) + ALLOCATE(OutData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i2 = LBOUND(OutData%M11,2), UBOUND(OutData%M11,2) + DO i1 = LBOUND(OutData%M11,1), UBOUND(OutData%M11,1) + OutData%M11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAM))-1 ) = PACK(InData%PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Damp))-1 ) = PACK(InData%Damp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Damp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Stff))-1 ) = PACK(InData%Stff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Stff) - IF ( .NOT. ALLOCATED(InData%PtfmFt) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M12 not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmFt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmFt,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmFt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmFt,2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%PtfmFt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) + IF (ALLOCATED(OutData%M12)) DEALLOCATE(OutData%M12) + ALLOCATE(OutData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%M12,2), UBOUND(OutData%M12,2) + DO i1 = LBOUND(OutData%M12,1), UBOUND(OutData%M12,1) + OutData%M12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%PtfmFt_t) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M22 not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmFt_t,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmFt_t,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%PtfmFt_t)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt_t))-1 ) = PACK(InData%PtfmFt_t,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt_t) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%M22)) DEALLOCATE(OutData%M22) + ALLOCATE(OutData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%M22,2), UBOUND(OutData%M22,2) + DO i1 = LBOUND(OutData%M22,1), UBOUND(OutData%M22,1) + OutData%M22(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nPtfmFt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_PackParam - - SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%PtfmAM,1) - i1_u = UBOUND(OutData%PtfmAM,1) - i2_l = LBOUND(OutData%PtfmAM,2) - i2_u = UBOUND(OutData%PtfmAM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M21 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%M21)) DEALLOCATE(OutData%M21) + ALLOCATE(OutData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%M21,2), UBOUND(OutData%M21,2) + DO i1 = LBOUND(OutData%M21,1), UBOUND(OutData%M21,1) + OutData%M21(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K11 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%K11)) DEALLOCATE(OutData%K11) + ALLOCATE(OutData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%K11,2), UBOUND(OutData%K11,2) + DO i1 = LBOUND(OutData%K11,1), UBOUND(OutData%K11,1) + OutData%K11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K22 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%K22)) DEALLOCATE(OutData%K22) + ALLOCATE(OutData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%K22,2), UBOUND(OutData%K22,2) + DO i1 = LBOUND(OutData%K22,1), UBOUND(OutData%K22,1) + OutData%K22(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C11 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C11)) DEALLOCATE(OutData%C11) + ALLOCATE(OutData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - OutData%PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAM) - DEALLOCATE(mask2) - i1_l = LBOUND(OutData%Damp,1) - i1_u = UBOUND(OutData%Damp,1) - i2_l = LBOUND(OutData%Damp,2) - i2_u = UBOUND(OutData%Damp,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%C11,2), UBOUND(OutData%C11,2) + DO i1 = LBOUND(OutData%C11,1), UBOUND(OutData%C11,1) + OutData%C11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C12 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C12)) DEALLOCATE(OutData%C12) + ALLOCATE(OutData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - OutData%Damp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Damp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Damp) - DEALLOCATE(mask2) - i1_l = LBOUND(OutData%Stff,1) - i1_u = UBOUND(OutData%Stff,1) - i2_l = LBOUND(OutData%Stff,2) - i2_u = UBOUND(OutData%Stff,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%C12,2), UBOUND(OutData%C12,2) + DO i1 = LBOUND(OutData%C12,1), UBOUND(OutData%C12,1) + OutData%C12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C22 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C22)) DEALLOCATE(OutData%C22) + ALLOCATE(OutData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - OutData%Stff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Stff))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Stff) - DEALLOCATE(mask2) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmFt not allocated + DO i2 = LBOUND(OutData%C22,2), UBOUND(OutData%C22,2) + DO i1 = LBOUND(OutData%C22,1), UBOUND(OutData%C22,1) + OutData%C22(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C21 not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -1588,49 +4118,130 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmFt)) DEALLOCATE(OutData%PtfmFt) - ALLOCATE(OutData%PtfmFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%C21)) DEALLOCATE(OutData%C21) + ALLOCATE(OutData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmFt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%C21,2), UBOUND(OutData%C21,2) + DO i1 = LBOUND(OutData%C21,1), UBOUND(OutData%C21,1) + OutData%C21(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%EP_DeltaT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%nTimeSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nCB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nCBFull = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nTot = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) + ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%PtfmFt)>0) OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask2) + DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) + OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmFt_t not allocated + 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%PtfmFt_t)) DEALLOCATE(OutData%PtfmFt_t) - ALLOCATE(OutData%PtfmFt_t(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%PtfmFt_t.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) + ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%PtfmFt_t)>0) OutData%PtfmFt_t = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt_t))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt_t) - DEALLOCATE(mask1) + DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) + DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) + OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%nPtfmFt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackParam SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1787,12 +4398,6 @@ SUBROUTINE ExtPtfm_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInput' @@ -2018,8 +4623,10 @@ SUBROUTINE ExtPtfm_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_PackOutput @@ -2036,12 +4643,6 @@ SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2109,15 +4710,10 @@ SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_UnPackOutput @@ -2196,8 +4792,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2212,6 +4808,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE ExtPtfm_Input_ExtrapInterp1 @@ -2243,8 +4841,9 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp2' @@ -2266,6 +4865,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE ExtPtfm_Input_ExtrapInterp2 @@ -2345,12 +4946,12 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2363,15 +4964,15 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE ExtPtfm_Output_ExtrapInterp1 @@ -2402,13 +5003,14 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2427,16 +5029,16 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE ExtPtfm_Output_ExtrapInterp2 diff --git a/modules/feamooring/src/FEAM.f90 b/modules/feamooring/src/FEAM.f90 index d3a60ba1a6..7402e939fd 100644 --- a/modules/feamooring/src/FEAM.f90 +++ b/modules/feamooring/src/FEAM.f90 @@ -312,7 +312,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -823,7 +823,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; diff --git a/modules/feamooring/src/FEAM_Registry.txt b/modules/feamooring/src/FEAM_Registry.txt index 34928e330d..c0482b23bd 100644 --- a/modules/feamooring/src/FEAM_Registry.txt +++ b/modules/feamooring/src/FEAM_Registry.txt @@ -49,7 +49,7 @@ typedef ^ ^ LOGICAL TabDelim - typedef ^ ^ CHARACTER(20) OutFmt - - - "Format used for text tabular output (except time)" - typedef ^ ^ DbKi Tstart - - - "Time to start module's tabular output" s typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ^ CHARACTER(10) OutList {:} - - "List of user-requested output channels" - +typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 05747f0890..ffed532365 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -65,7 +65,7 @@ MODULE FEAMooring_Types CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] REAL(DbKi) :: Tstart !< Time to start module's tabular output [s] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE FEAM_InputFile ! ======================= ! ========= FEAM_InitInputType ======= @@ -713,8 +713,8 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -725,8 +725,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCI))-1 ) = PACK(InData%LineCI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCI) + DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) + ReKiBuf(Re_Xferred) = InData%LineCI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -738,8 +740,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCD))-1 ) = PACK(InData%LineCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCD) + DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) + ReKiBuf(Re_Xferred) = InData%LineCD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -751,8 +755,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LEAStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LEAStiff))-1 ) = PACK(InData%LEAStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LEAStiff) + DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) + ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -764,8 +770,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LMassDen))-1 ) = PACK(InData%LMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LMassDen) + DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) + ReKiBuf(Re_Xferred) = InData%LMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -777,8 +785,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDMassDen))-1 ) = PACK(InData%LDMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDMassDen) + DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) + ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -790,8 +800,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmStiff))-1 ) = PACK(InData%BottmStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmStiff) + DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) + ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LRadAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -803,8 +815,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LRadAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LRadAnch))-1 ) = PACK(InData%LRadAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LRadAnch) + DO i1 = LBOUND(InData%LRadAnch,1), UBOUND(InData%LRadAnch,1) + ReKiBuf(Re_Xferred) = InData%LRadAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAngAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -816,8 +830,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAngAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAngAnch))-1 ) = PACK(InData%LAngAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAngAnch) + DO i1 = LBOUND(InData%LAngAnch,1), UBOUND(InData%LAngAnch,1) + ReKiBuf(Re_Xferred) = InData%LAngAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDpthAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -829,8 +845,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDpthAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDpthAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDpthAnch))-1 ) = PACK(InData%LDpthAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDpthAnch) + DO i1 = LBOUND(InData%LDpthAnch,1), UBOUND(InData%LDpthAnch,1) + ReKiBuf(Re_Xferred) = InData%LDpthAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LRadFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -842,8 +860,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LRadFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LRadFair))-1 ) = PACK(InData%LRadFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LRadFair) + DO i1 = LBOUND(InData%LRadFair,1), UBOUND(InData%LRadFair,1) + ReKiBuf(Re_Xferred) = InData%LRadFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAngFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -855,8 +875,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAngFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAngFair))-1 ) = PACK(InData%LAngFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAngFair) + DO i1 = LBOUND(InData%LAngFair,1), UBOUND(InData%LAngFair,1) + ReKiBuf(Re_Xferred) = InData%LAngFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDrftFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -868,8 +890,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDrftFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDrftFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDrftFair))-1 ) = PACK(InData%LDrftFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDrftFair) + DO i1 = LBOUND(InData%LDrftFair,1), UBOUND(InData%LDrftFair,1) + ReKiBuf(Re_Xferred) = InData%LDrftFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LUnstrLen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -881,8 +905,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LUnstrLen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LUnstrLen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LUnstrLen))-1 ) = PACK(InData%LUnstrLen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LUnstrLen) + DO i1 = LBOUND(InData%LUnstrLen,1), UBOUND(InData%LUnstrLen,1) + ReKiBuf(Re_Xferred) = InData%LUnstrLen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Tension) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -894,8 +920,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tension,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Tension)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Tension))-1 ) = PACK(InData%Tension,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Tension) + DO i1 = LBOUND(InData%Tension,1), UBOUND(InData%Tension,1) + ReKiBuf(Re_Xferred) = InData%Tension(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GSL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -913,8 +941,14 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSL))-1 ) = PACK(InData%GSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSL) + DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) + DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) + DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) + ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GSR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -929,8 +963,12 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSR))-1 ) = PACK(InData%GSR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSR) + DO i2 = LBOUND(InData%GSR,2), UBOUND(InData%GSR,2) + DO i1 = LBOUND(InData%GSR,1), UBOUND(InData%GSR,1) + ReKiBuf(Re_Xferred) = InData%GSR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -948,35 +986,41 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GE))-1 ) = PACK(InData%GE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GE) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i3 = LBOUND(InData%GE,3), UBOUND(InData%GE,3) + DO i2 = LBOUND(InData%GE,2), UBOUND(InData%GE,2) + DO i1 = LBOUND(InData%GE,1), UBOUND(InData%GE,1) + ReKiBuf(Re_Xferred) = InData%GE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElems + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Eps + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxIter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -987,12 +1031,12 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE FEAM_PackInputFile @@ -1009,12 +1053,6 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1032,8 +1070,8 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1047,15 +1085,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCI)>0) OutData%LineCI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) + OutData%LineCI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated Int_Xferred = Int_Xferred + 1 @@ -1070,15 +1103,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCD)>0) OutData%LineCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) + OutData%LineCD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -1093,15 +1121,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LEAStiff)>0) OutData%LEAStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LEAStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LEAStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) + OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -1116,15 +1139,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LMassDen)>0) OutData%LMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) + OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -1139,15 +1157,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDMassDen)>0) OutData%LDMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) + OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -1162,15 +1175,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmStiff)>0) OutData%BottmStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) + OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1185,15 +1193,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LRadAnch)>0) OutData%LRadAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LRadAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LRadAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LRadAnch,1), UBOUND(OutData%LRadAnch,1) + OutData%LRadAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1208,15 +1211,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAngAnch)>0) OutData%LAngAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAngAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAngAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAngAnch,1), UBOUND(OutData%LAngAnch,1) + OutData%LAngAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDpthAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1231,15 +1229,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDpthAnch)>0) OutData%LDpthAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDpthAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDpthAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDpthAnch,1), UBOUND(OutData%LDpthAnch,1) + OutData%LDpthAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1254,15 +1247,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LRadFair)>0) OutData%LRadFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LRadFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LRadFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LRadFair,1), UBOUND(OutData%LRadFair,1) + OutData%LRadFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1277,15 +1265,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAngFair)>0) OutData%LAngFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAngFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAngFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAngFair,1), UBOUND(OutData%LAngFair,1) + OutData%LAngFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDrftFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1300,15 +1283,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDrftFair)>0) OutData%LDrftFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDrftFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDrftFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDrftFair,1), UBOUND(OutData%LDrftFair,1) + OutData%LDrftFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LUnstrLen not allocated Int_Xferred = Int_Xferred + 1 @@ -1323,15 +1301,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LUnstrLen)>0) OutData%LUnstrLen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LUnstrLen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LUnstrLen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LUnstrLen,1), UBOUND(OutData%LUnstrLen,1) + OutData%LUnstrLen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tension not allocated Int_Xferred = Int_Xferred + 1 @@ -1346,15 +1319,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Tension)>0) OutData%Tension = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Tension))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Tension) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Tension,1), UBOUND(OutData%Tension,1) + OutData%Tension(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated Int_Xferred = Int_Xferred + 1 @@ -1375,15 +1343,14 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GSL)>0) OutData%GSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) + DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) + DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) + OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSR not allocated Int_Xferred = Int_Xferred + 1 @@ -1401,15 +1368,12 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GSR)>0) OutData%GSR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GSR,2), UBOUND(OutData%GSR,2) + DO i1 = LBOUND(OutData%GSR,1), UBOUND(OutData%GSR,1) + OutData%GSR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GE not allocated Int_Xferred = Int_Xferred + 1 @@ -1430,42 +1394,41 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GE)>0) OutData%GE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GE) - DEALLOCATE(mask3) - END IF - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Eps = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i3 = LBOUND(OutData%GE,3), UBOUND(OutData%GE,3) + DO i2 = LBOUND(OutData%GE,2), UBOUND(OutData%GE,2) + DO i1 = LBOUND(OutData%GE,1), UBOUND(OutData%GE,1) + OutData%GE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumElems = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Eps = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1479,19 +1442,12 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE FEAM_UnPackInputFile @@ -1667,18 +1623,20 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmInit))-1 ) = PACK(InData%PtfmInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmInit) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1695,8 +1653,14 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc0))-1 ) = PACK(InData%WaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc0) + DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) + DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) + DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1708,8 +1672,10 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1727,13 +1693,19 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel0))-1 ) = PACK(InData%WaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel0) + DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) + DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) + DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_PackInitInput SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1749,12 +1721,6 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1771,27 +1737,22 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%PtfmInit,1) i1_u = UBOUND(OutData%PtfmInit,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmInit) - DEALLOCATE(mask1) - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1811,15 +1772,14 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc0)>0) OutData%WaveAcc0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) + DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) + DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) + OutData%WaveAcc0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -1834,15 +1794,10 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1863,20 +1818,19 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel0)>0) OutData%WaveVel0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) + DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) + DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) + OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_UnPackInitInput SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2161,12 +2115,12 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2178,12 +2132,12 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -2223,8 +2177,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchxi))-1 ) = PACK(InData%LAnchxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchxi) + DO i1 = LBOUND(InData%LAnchxi,1), UBOUND(InData%LAnchxi,1) + ReKiBuf(Re_Xferred) = InData%LAnchxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAnchyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2236,8 +2192,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchyi))-1 ) = PACK(InData%LAnchyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchyi) + DO i1 = LBOUND(InData%LAnchyi,1), UBOUND(InData%LAnchyi,1) + ReKiBuf(Re_Xferred) = InData%LAnchyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAnchzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2249,8 +2207,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchzi))-1 ) = PACK(InData%LAnchzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchzi) + DO i1 = LBOUND(InData%LAnchzi,1), UBOUND(InData%LAnchzi,1) + ReKiBuf(Re_Xferred) = InData%LAnchzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairxt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2262,8 +2222,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairxt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairxt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairxt))-1 ) = PACK(InData%LFairxt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairxt) + DO i1 = LBOUND(InData%LFairxt,1), UBOUND(InData%LFairxt,1) + ReKiBuf(Re_Xferred) = InData%LFairxt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairyt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2275,8 +2237,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairyt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairyt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairyt))-1 ) = PACK(InData%LFairyt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairyt) + DO i1 = LBOUND(InData%LFairyt,1), UBOUND(InData%LFairyt,1) + ReKiBuf(Re_Xferred) = InData%LFairyt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairzt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2288,8 +2252,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairzt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairzt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairzt))-1 ) = PACK(InData%LFairzt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairzt) + DO i1 = LBOUND(InData%LFairzt,1), UBOUND(InData%LFairzt,1) + ReKiBuf(Re_Xferred) = InData%LFairzt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FEAM_PackInitOutput @@ -2306,12 +2272,6 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2339,19 +2299,12 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2366,19 +2319,12 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2379,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchxi)>0) OutData%LAnchxi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchxi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchxi,1), UBOUND(OutData%LAnchxi,1) + OutData%LAnchxi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchyi not allocated Int_Xferred = Int_Xferred + 1 @@ -2456,15 +2397,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchyi)>0) OutData%LAnchyi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchyi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchyi,1), UBOUND(OutData%LAnchyi,1) + OutData%LAnchyi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchzi not allocated Int_Xferred = Int_Xferred + 1 @@ -2479,15 +2415,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchzi)>0) OutData%LAnchzi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchzi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchzi,1), UBOUND(OutData%LAnchzi,1) + OutData%LAnchzi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairxt not allocated Int_Xferred = Int_Xferred + 1 @@ -2502,15 +2433,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairxt)>0) OutData%LFairxt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairxt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairxt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairxt,1), UBOUND(OutData%LFairxt,1) + OutData%LFairxt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairyt not allocated Int_Xferred = Int_Xferred + 1 @@ -2525,15 +2451,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairyt)>0) OutData%LFairyt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairyt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairyt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairyt,1), UBOUND(OutData%LFairyt,1) + OutData%LFairyt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairzt not allocated Int_Xferred = Int_Xferred + 1 @@ -2548,15 +2469,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairzt)>0) OutData%LFairzt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairzt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairzt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairzt,1), UBOUND(OutData%LFairzt,1) + OutData%LFairzt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FEAM_UnPackInitOutput @@ -2708,8 +2624,12 @@ SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLU))-1 ) = PACK(InData%GLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLU) + DO i2 = LBOUND(InData%GLU,2), UBOUND(InData%GLU,2) + DO i1 = LBOUND(InData%GLU,1), UBOUND(InData%GLU,1) + ReKiBuf(Re_Xferred) = InData%GLU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLDU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2724,8 +2644,12 @@ SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLDU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLDU))-1 ) = PACK(InData%GLDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLDU) + DO i2 = LBOUND(InData%GLDU,2), UBOUND(InData%GLDU,2) + DO i1 = LBOUND(InData%GLDU,1), UBOUND(InData%GLDU,1) + ReKiBuf(Re_Xferred) = InData%GLDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_PackContState @@ -2742,12 +2666,6 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2779,15 +2697,12 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLU)>0) OutData%GLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLU,2), UBOUND(OutData%GLU,2) + DO i1 = LBOUND(OutData%GLU,1), UBOUND(OutData%GLU,1) + OutData%GLU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDU not allocated Int_Xferred = Int_Xferred + 1 @@ -2805,15 +2720,12 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLDU)>0) OutData%GLDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLDU,2), UBOUND(OutData%GLDU,2) + DO i1 = LBOUND(OutData%GLDU,1), UBOUND(OutData%GLDU,1) + OutData%GLDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_UnPackContState @@ -2908,8 +2820,8 @@ SUBROUTINE FEAM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_PackDiscState SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2925,12 +2837,6 @@ SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackDiscState' @@ -2944,8 +2850,8 @@ SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_UnPackDiscState SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3042,10 +2948,14 @@ SUBROUTINE FEAM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TSN))-1 ) = PACK(InData%TSN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TSN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TZER))-1 ) = PACK(InData%TZER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TZER) + DO i1 = LBOUND(InData%TSN,1), UBOUND(InData%TSN,1) + ReKiBuf(Re_Xferred) = InData%TSN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TZER,1), UBOUND(InData%TZER,1) + ReKiBuf(Re_Xferred) = InData%TZER(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FEAM_PackConstrState SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3061,12 +2971,6 @@ SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3083,26 +2987,16 @@ SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%TSN,1) i1_u = UBOUND(OutData%TSN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TSN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TSN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TSN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TSN,1), UBOUND(OutData%TSN,1) + OutData%TSN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TZER,1) i1_u = UBOUND(OutData%TZER,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TZER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TZER))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TZER) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TZER,1), UBOUND(OutData%TZER,1) + OutData%TZER(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FEAM_UnPackConstrState SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3359,8 +3253,12 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLU0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLU0))-1 ) = PACK(InData%GLU0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLU0) + DO i2 = LBOUND(InData%GLU0,2), UBOUND(InData%GLU0,2) + DO i1 = LBOUND(InData%GLU0,1), UBOUND(InData%GLU0,1) + ReKiBuf(Re_Xferred) = InData%GLU0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLDDU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3375,11 +3273,15 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLDDU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLDDU))-1 ) = PACK(InData%GLDDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLDDU) + DO i2 = LBOUND(InData%GLDDU,2), UBOUND(InData%GLDDU,2) + DO i1 = LBOUND(InData%GLDDU,1), UBOUND(InData%GLDDU,1) + ReKiBuf(Re_Xferred) = InData%GLDDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BottomTouch , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BottomTouch, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GFORC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3396,8 +3298,14 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GFORC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GFORC0))-1 ) = PACK(InData%GFORC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GFORC0) + DO i3 = LBOUND(InData%GFORC0,3), UBOUND(InData%GFORC0,3) + DO i2 = LBOUND(InData%GFORC0,2), UBOUND(InData%GFORC0,2) + DO i1 = LBOUND(InData%GFORC0,1), UBOUND(InData%GFORC0,1) + ReKiBuf(Re_Xferred) = InData%GFORC0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GMASS0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3418,8 +3326,16 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GMASS0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GMASS0))-1 ) = PACK(InData%GMASS0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GMASS0) + DO i4 = LBOUND(InData%GMASS0,4), UBOUND(InData%GMASS0,4) + DO i3 = LBOUND(InData%GMASS0,3), UBOUND(InData%GMASS0,3) + DO i2 = LBOUND(InData%GMASS0,2), UBOUND(InData%GMASS0,2) + DO i1 = LBOUND(InData%GMASS0,1), UBOUND(InData%GMASS0,1) + ReKiBuf(Re_Xferred) = InData%GMASS0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAST_FPA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3434,8 +3350,12 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_FPA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_FPA))-1 ) = PACK(InData%FAST_FPA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_FPA) + DO i2 = LBOUND(InData%FAST_FPA,2), UBOUND(InData%FAST_FPA,2) + DO i1 = LBOUND(InData%FAST_FPA,1), UBOUND(InData%FAST_FPA,1) + ReKiBuf(Re_Xferred) = InData%FAST_FPA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAST_RP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3450,17 +3370,29 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_RP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_RP))-1 ) = PACK(InData%FAST_RP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_RP) + DO i2 = LBOUND(InData%FAST_RP,2), UBOUND(InData%FAST_RP,2) + DO i1 = LBOUND(InData%FAST_RP,1), UBOUND(InData%FAST_RP,1) + ReKiBuf(Re_Xferred) = InData%FAST_RP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%INCR - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RSDF))-1 ) = PACK(InData%RSDF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RSDF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FORC0))-1 ) = PACK(InData%FORC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FORC0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EMAS0))-1 ) = PACK(InData%EMAS0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EMAS0) + IntKiBuf(Int_Xferred) = InData%INCR + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RSDF,1), UBOUND(InData%RSDF,1) + ReKiBuf(Re_Xferred) = InData%RSDF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FORC0,1), UBOUND(InData%FORC0,1) + ReKiBuf(Re_Xferred) = InData%FORC0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%EMAS0,2), UBOUND(InData%EMAS0,2) + DO i1 = LBOUND(InData%EMAS0,1), UBOUND(InData%EMAS0,1) + ReKiBuf(Re_Xferred) = InData%EMAS0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE FEAM_PackOtherState SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3476,12 +3408,6 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -3515,15 +3441,12 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLU0)>0) OutData%GLU0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLU0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLU0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLU0,2), UBOUND(OutData%GLU0,2) + DO i1 = LBOUND(OutData%GLU0,1), UBOUND(OutData%GLU0,1) + OutData%GLU0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDDU not allocated Int_Xferred = Int_Xferred + 1 @@ -3541,18 +3464,15 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLDDU)>0) OutData%GLDDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLDDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLDDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLDDU,2), UBOUND(OutData%GLDDU,2) + DO i1 = LBOUND(OutData%GLDDU,1), UBOUND(OutData%GLDDU,1) + OutData%GLDDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%BottomTouch = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%BottomTouch = TRANSFER(IntKiBuf(Int_Xferred), OutData%BottomTouch) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GFORC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3572,15 +3492,14 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GFORC0)>0) OutData%GFORC0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GFORC0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GFORC0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GFORC0,3), UBOUND(OutData%GFORC0,3) + DO i2 = LBOUND(OutData%GFORC0,2), UBOUND(OutData%GFORC0,2) + DO i1 = LBOUND(OutData%GFORC0,1), UBOUND(OutData%GFORC0,1) + OutData%GFORC0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GMASS0 not allocated Int_Xferred = Int_Xferred + 1 @@ -3604,15 +3523,16 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%GMASS0)>0) OutData%GMASS0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GMASS0))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GMASS0) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%GMASS0,4), UBOUND(OutData%GMASS0,4) + DO i3 = LBOUND(OutData%GMASS0,3), UBOUND(OutData%GMASS0,3) + DO i2 = LBOUND(OutData%GMASS0,2), UBOUND(OutData%GMASS0,2) + DO i1 = LBOUND(OutData%GMASS0,1), UBOUND(OutData%GMASS0,1) + OutData%GMASS0(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FPA not allocated Int_Xferred = Int_Xferred + 1 @@ -3630,15 +3550,12 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_FPA)>0) OutData%FAST_FPA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_FPA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_FPA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_FPA,2), UBOUND(OutData%FAST_FPA,2) + DO i1 = LBOUND(OutData%FAST_FPA,1), UBOUND(OutData%FAST_FPA,1) + OutData%FAST_FPA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_RP not allocated Int_Xferred = Int_Xferred + 1 @@ -3656,53 +3573,37 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_RP)>0) OutData%FAST_RP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_RP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_RP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_RP,2), UBOUND(OutData%FAST_RP,2) + DO i1 = LBOUND(OutData%FAST_RP,1), UBOUND(OutData%FAST_RP,1) + OutData%FAST_RP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%INCR = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%INCR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RSDF,1) i1_u = UBOUND(OutData%RSDF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RSDF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RSDF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RSDF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RSDF,1), UBOUND(OutData%RSDF,1) + OutData%RSDF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FORC0,1) i1_u = UBOUND(OutData%FORC0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FORC0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FORC0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FORC0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FORC0,1), UBOUND(OutData%FORC0,1) + OutData%FORC0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%EMAS0,1) i1_u = UBOUND(OutData%EMAS0,1) i2_l = LBOUND(OutData%EMAS0,2) i2_u = UBOUND(OutData%EMAS0,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%EMAS0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EMAS0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EMAS0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EMAS0,2), UBOUND(OutData%EMAS0,2) + DO i1 = LBOUND(OutData%EMAS0,1), UBOUND(OutData%EMAS0,1) + OutData%EMAS0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE FEAM_UnPackOtherState SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -4060,8 +3961,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLF))-1 ) = PACK(InData%GLF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLF) + DO i2 = LBOUND(InData%GLF,2), UBOUND(InData%GLF,2) + DO i1 = LBOUND(InData%GLF,1), UBOUND(InData%GLF,1) + ReKiBuf(Re_Xferred) = InData%GLF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4079,13 +3984,27 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLK)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLK))-1 ) = PACK(InData%GLK,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLK) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EMASS))-1 ) = PACK(InData%EMASS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EMASS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ESTIF))-1 ) = PACK(InData%ESTIF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ESTIF) + DO i3 = LBOUND(InData%GLK,3), UBOUND(InData%GLK,3) + DO i2 = LBOUND(InData%GLK,2), UBOUND(InData%GLK,2) + DO i1 = LBOUND(InData%GLK,1), UBOUND(InData%GLK,1) + ReKiBuf(Re_Xferred) = InData%GLK(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%EMASS,2), UBOUND(InData%EMASS,2) + DO i1 = LBOUND(InData%EMASS,1), UBOUND(InData%EMASS,1) + ReKiBuf(Re_Xferred) = InData%EMASS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%ESTIF,2), UBOUND(InData%ESTIF,2) + DO i1 = LBOUND(InData%ESTIF,1), UBOUND(InData%ESTIF,1) + ReKiBuf(Re_Xferred) = InData%ESTIF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%FAST_FP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4099,31 +4018,67 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_FP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_FP))-1 ) = PACK(InData%FAST_FP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_FP) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FORCE))-1 ) = PACK(InData%FORCE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FORCE) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FP))-1 ) = PACK(InData%FP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U))-1 ) = PACK(InData%U,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U0))-1 ) = PACK(InData%U0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DU))-1 ) = PACK(InData%DU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DDU))-1 ) = PACK(InData%DDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DDU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R))-1 ) = PACK(InData%R,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RP))-1 ) = PACK(InData%RP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RHSR))-1 ) = PACK(InData%RHSR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RHSR) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SLIN))-1 ) = PACK(InData%SLIN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SLIN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%STIFR))-1 ) = PACK(InData%STIFR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%STIFR) + DO i2 = LBOUND(InData%FAST_FP,2), UBOUND(InData%FAST_FP,2) + DO i1 = LBOUND(InData%FAST_FP,1), UBOUND(InData%FAST_FP,1) + ReKiBuf(Re_Xferred) = InData%FAST_FP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%FORCE,1), UBOUND(InData%FORCE,1) + ReKiBuf(Re_Xferred) = InData%FORCE(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FP,1), UBOUND(InData%FP,1) + ReKiBuf(Re_Xferred) = InData%FP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + ReKiBuf(Re_Xferred) = InData%U(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%U0,2), UBOUND(InData%U0,2) + DO i1 = LBOUND(InData%U0,1), UBOUND(InData%U0,1) + ReKiBuf(Re_Xferred) = InData%U0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%DU,2), UBOUND(InData%DU,2) + DO i1 = LBOUND(InData%DU,1), UBOUND(InData%DU,1) + ReKiBuf(Re_Xferred) = InData%DU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%DDU,2), UBOUND(InData%DDU,2) + DO i1 = LBOUND(InData%DDU,1), UBOUND(InData%DDU,1) + ReKiBuf(Re_Xferred) = InData%DDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) + ReKiBuf(Re_Xferred) = InData%R(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RP,1), UBOUND(InData%RP,1) + ReKiBuf(Re_Xferred) = InData%RP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RHSR,1), UBOUND(InData%RHSR,1) + ReKiBuf(Re_Xferred) = InData%RHSR(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SLIN,1), UBOUND(InData%SLIN,1) + ReKiBuf(Re_Xferred) = InData%SLIN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%STIFR,2), UBOUND(InData%STIFR,2) + DO i1 = LBOUND(InData%STIFR,1), UBOUND(InData%STIFR,1) + ReKiBuf(Re_Xferred) = InData%STIFR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%FAIR_ANG) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4137,8 +4092,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAIR_ANG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAIR_ANG))-1 ) = PACK(InData%FAIR_ANG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAIR_ANG) + DO i2 = LBOUND(InData%FAIR_ANG,2), UBOUND(InData%FAIR_ANG,2) + DO i1 = LBOUND(InData%FAIR_ANG,1), UBOUND(InData%FAIR_ANG,1) + ReKiBuf(Re_Xferred) = InData%FAIR_ANG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAIR_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4150,8 +4109,10 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAIR_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAIR_T))-1 ) = PACK(InData%FAIR_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAIR_T) + DO i1 = LBOUND(InData%FAIR_T,1), UBOUND(InData%FAIR_T,1) + ReKiBuf(Re_Xferred) = InData%FAIR_T(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ANCH_ANG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4166,8 +4127,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANCH_ANG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANCH_ANG))-1 ) = PACK(InData%ANCH_ANG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANCH_ANG) + DO i2 = LBOUND(InData%ANCH_ANG,2), UBOUND(InData%ANCH_ANG,2) + DO i1 = LBOUND(InData%ANCH_ANG,1), UBOUND(InData%ANCH_ANG,1) + ReKiBuf(Re_Xferred) = InData%ANCH_ANG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ANCH_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4179,8 +4144,10 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANCH_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANCH_T))-1 ) = PACK(InData%ANCH_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANCH_T) + DO i1 = LBOUND(InData%ANCH_T,1), UBOUND(InData%ANCH_T,1) + ReKiBuf(Re_Xferred) = InData%ANCH_T(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Line_Coordinate) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4198,8 +4165,14 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Line_Coordinate)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Line_Coordinate))-1 ) = PACK(InData%Line_Coordinate,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Line_Coordinate) + DO i3 = LBOUND(InData%Line_Coordinate,3), UBOUND(InData%Line_Coordinate,3) + DO i2 = LBOUND(InData%Line_Coordinate,2), UBOUND(InData%Line_Coordinate,2) + DO i1 = LBOUND(InData%Line_Coordinate,1), UBOUND(InData%Line_Coordinate,1) + ReKiBuf(Re_Xferred) = InData%Line_Coordinate(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Line_Tangent) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4217,8 +4190,14 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Line_Tangent)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Line_Tangent))-1 ) = PACK(InData%Line_Tangent,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Line_Tangent) + DO i3 = LBOUND(InData%Line_Tangent,3), UBOUND(InData%Line_Tangent,3) + DO i2 = LBOUND(InData%Line_Tangent,2), UBOUND(InData%Line_Tangent,2) + DO i1 = LBOUND(InData%Line_Tangent,1), UBOUND(InData%Line_Tangent,1) + ReKiBuf(Re_Xferred) = InData%Line_Tangent(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F_Lines) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4233,11 +4212,15 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_Lines)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Lines))-1 ) = PACK(InData%F_Lines,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Lines) + DO i2 = LBOUND(InData%F_Lines,2), UBOUND(InData%F_Lines,2) + DO i1 = LBOUND(InData%F_Lines,1), UBOUND(InData%F_Lines,1) + ReKiBuf(Re_Xferred) = InData%F_Lines(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FEAM_PackMisc SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4253,12 +4236,6 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4291,15 +4268,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLF)>0) OutData%GLF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLF,2), UBOUND(OutData%GLF,2) + DO i1 = LBOUND(OutData%GLF,1), UBOUND(OutData%GLF,1) + OutData%GLF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLK not allocated Int_Xferred = Int_Xferred + 1 @@ -4320,42 +4294,35 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GLK)>0) OutData%GLK = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLK))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLK) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GLK,3), UBOUND(OutData%GLK,3) + DO i2 = LBOUND(OutData%GLK,2), UBOUND(OutData%GLK,2) + DO i1 = LBOUND(OutData%GLK,1), UBOUND(OutData%GLK,1) + OutData%GLK(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%EMASS,1) i1_u = UBOUND(OutData%EMASS,1) i2_l = LBOUND(OutData%EMASS,2) i2_u = UBOUND(OutData%EMASS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%EMASS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EMASS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EMASS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EMASS,2), UBOUND(OutData%EMASS,2) + DO i1 = LBOUND(OutData%EMASS,1), UBOUND(OutData%EMASS,1) + OutData%EMASS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%ESTIF,1) i1_u = UBOUND(OutData%ESTIF,1) i2_l = LBOUND(OutData%ESTIF,2) i2_u = UBOUND(OutData%ESTIF,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%ESTIF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ESTIF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ESTIF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ESTIF,2), UBOUND(OutData%ESTIF,2) + DO i1 = LBOUND(OutData%ESTIF,1), UBOUND(OutData%ESTIF,1) + OutData%ESTIF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4372,147 +4339,99 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_FP)>0) OutData%FAST_FP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_FP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_FP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_FP,2), UBOUND(OutData%FAST_FP,2) + DO i1 = LBOUND(OutData%FAST_FP,1), UBOUND(OutData%FAST_FP,1) + OutData%FAST_FP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FORCE,1) i1_u = UBOUND(OutData%FORCE,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FORCE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FORCE))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FORCE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FORCE,1), UBOUND(OutData%FORCE,1) + OutData%FORCE(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FP,1) i1_u = UBOUND(OutData%FP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FP,1), UBOUND(OutData%FP,1) + OutData%FP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%U,1) i1_u = UBOUND(OutData%U,1) i2_l = LBOUND(OutData%U,2) i2_u = UBOUND(OutData%U,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%U = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%U0,1) i1_u = UBOUND(OutData%U0,1) i2_l = LBOUND(OutData%U0,2) i2_u = UBOUND(OutData%U0,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%U0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%U0,2), UBOUND(OutData%U0,2) + DO i1 = LBOUND(OutData%U0,1), UBOUND(OutData%U0,1) + OutData%U0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%DU,1) i1_u = UBOUND(OutData%DU,1) i2_l = LBOUND(OutData%DU,2) i2_u = UBOUND(OutData%DU,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DU,2), UBOUND(OutData%DU,2) + DO i1 = LBOUND(OutData%DU,1), UBOUND(OutData%DU,1) + OutData%DU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%DDU,1) i1_u = UBOUND(OutData%DDU,1) i2_l = LBOUND(OutData%DDU,2) i2_u = UBOUND(OutData%DDU,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DDU,2), UBOUND(OutData%DDU,2) + DO i1 = LBOUND(OutData%DDU,1), UBOUND(OutData%DDU,1) + OutData%DDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%R,1) i1_u = UBOUND(OutData%R,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%R = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) + OutData%R(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RP,1) i1_u = UBOUND(OutData%RP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RP,1), UBOUND(OutData%RP,1) + OutData%RP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RHSR,1) i1_u = UBOUND(OutData%RHSR,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RHSR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RHSR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RHSR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RHSR,1), UBOUND(OutData%RHSR,1) + OutData%RHSR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SLIN,1) i1_u = UBOUND(OutData%SLIN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SLIN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SLIN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SLIN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SLIN,1), UBOUND(OutData%SLIN,1) + OutData%SLIN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%STIFR,1) i1_u = UBOUND(OutData%STIFR,1) i2_l = LBOUND(OutData%STIFR,2) i2_u = UBOUND(OutData%STIFR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%STIFR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%STIFR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%STIFR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%STIFR,2), UBOUND(OutData%STIFR,2) + DO i1 = LBOUND(OutData%STIFR,1), UBOUND(OutData%STIFR,1) + OutData%STIFR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_ANG not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4529,15 +4448,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAIR_ANG)>0) OutData%FAIR_ANG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAIR_ANG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAIR_ANG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAIR_ANG,2), UBOUND(OutData%FAIR_ANG,2) + DO i1 = LBOUND(OutData%FAIR_ANG,1), UBOUND(OutData%FAIR_ANG,1) + OutData%FAIR_ANG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_T not allocated Int_Xferred = Int_Xferred + 1 @@ -4552,15 +4468,10 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FAIR_T)>0) OutData%FAIR_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAIR_T))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAIR_T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FAIR_T,1), UBOUND(OutData%FAIR_T,1) + OutData%FAIR_T(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_ANG not allocated Int_Xferred = Int_Xferred + 1 @@ -4578,15 +4489,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANCH_ANG)>0) OutData%ANCH_ANG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANCH_ANG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANCH_ANG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANCH_ANG,2), UBOUND(OutData%ANCH_ANG,2) + DO i1 = LBOUND(OutData%ANCH_ANG,1), UBOUND(OutData%ANCH_ANG,1) + OutData%ANCH_ANG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_T not allocated Int_Xferred = Int_Xferred + 1 @@ -4601,15 +4509,10 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ANCH_T)>0) OutData%ANCH_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANCH_T))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANCH_T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ANCH_T,1), UBOUND(OutData%ANCH_T,1) + OutData%ANCH_T(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Coordinate not allocated Int_Xferred = Int_Xferred + 1 @@ -4630,15 +4533,14 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Line_Coordinate)>0) OutData%Line_Coordinate = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Line_Coordinate))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Line_Coordinate) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Line_Coordinate,3), UBOUND(OutData%Line_Coordinate,3) + DO i2 = LBOUND(OutData%Line_Coordinate,2), UBOUND(OutData%Line_Coordinate,2) + DO i1 = LBOUND(OutData%Line_Coordinate,1), UBOUND(OutData%Line_Coordinate,1) + OutData%Line_Coordinate(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Tangent not allocated Int_Xferred = Int_Xferred + 1 @@ -4659,15 +4561,14 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Line_Tangent)>0) OutData%Line_Tangent = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Line_Tangent))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Line_Tangent) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Line_Tangent,3), UBOUND(OutData%Line_Tangent,3) + DO i2 = LBOUND(OutData%Line_Tangent,2), UBOUND(OutData%Line_Tangent,2) + DO i1 = LBOUND(OutData%Line_Tangent,1), UBOUND(OutData%Line_Tangent,1) + OutData%Line_Tangent(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Lines not allocated Int_Xferred = Int_Xferred + 1 @@ -4685,18 +4586,15 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_Lines)>0) OutData%F_Lines = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Lines))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Lines) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_Lines,2), UBOUND(OutData%F_Lines,2) + DO i1 = LBOUND(OutData%F_Lines,1), UBOUND(OutData%F_Lines,1) + OutData%F_Lines(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FEAM_UnPackMisc SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -5268,22 +5166,24 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GRAV))-1 ) = PACK(InData%GRAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GRAV) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NHBD - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDIM - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%GRAV,1), UBOUND(InData%GRAV,1) + ReKiBuf(Re_Xferred) = InData%GRAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Eps + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxIter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NHBD + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDIM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NEQ) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5294,17 +5194,19 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NEQ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NEQ)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NEQ))-1 ) = PACK(InData%NEQ,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NEQ) + DO i1 = LBOUND(InData%NEQ,1), UBOUND(InData%NEQ,1) + IntKiBuf(Int_Xferred) = InData%NEQ(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBAND - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBAND + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElems + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GSL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5321,8 +5223,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSL))-1 ) = PACK(InData%GSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSL) + DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) + DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) + DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) + ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5337,8 +5245,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GP))-1 ) = PACK(InData%GP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GP) + DO i2 = LBOUND(InData%GP,2), UBOUND(InData%GP,2) + DO i1 = LBOUND(InData%GP,1), UBOUND(InData%GP,1) + ReKiBuf(Re_Xferred) = InData%GP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Elength) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5350,8 +5262,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elength,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Elength)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Elength))-1 ) = PACK(InData%Elength,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Elength) + DO i1 = LBOUND(InData%Elength,1), UBOUND(InData%Elength,1) + ReKiBuf(Re_Xferred) = InData%Elength(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5363,8 +5277,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmElev))-1 ) = PACK(InData%BottmElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmElev) + DO i1 = LBOUND(InData%BottmElev,1), UBOUND(InData%BottmElev,1) + ReKiBuf(Re_Xferred) = InData%BottmElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5376,8 +5292,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmStiff))-1 ) = PACK(InData%BottmStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmStiff) + DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) + ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5389,8 +5307,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LMassDen))-1 ) = PACK(InData%LMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LMassDen) + DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) + ReKiBuf(Re_Xferred) = InData%LMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5402,8 +5322,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDMassDen))-1 ) = PACK(InData%LDMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDMassDen) + DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) + ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5415,8 +5337,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LEAStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LEAStiff))-1 ) = PACK(InData%LEAStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LEAStiff) + DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) + ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5428,8 +5352,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCI))-1 ) = PACK(InData%LineCI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCI) + DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) + ReKiBuf(Re_Xferred) = InData%LineCI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5441,8 +5367,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCD))-1 ) = PACK(InData%LineCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCD) + DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) + ReKiBuf(Re_Xferred) = InData%LineCD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Bvp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5457,8 +5385,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Bvp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Bvp))-1 ) = PACK(InData%Bvp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Bvp) + DO i2 = LBOUND(InData%Bvp,2), UBOUND(InData%Bvp,2) + DO i1 = LBOUND(InData%Bvp,1), UBOUND(InData%Bvp,1) + ReKiBuf(Re_Xferred) = InData%Bvp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5476,8 +5408,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc0))-1 ) = PACK(InData%WaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc0) + DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) + DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) + DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5489,8 +5427,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5508,53 +5448,119 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel0))-1 ) = PACK(InData%WaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel0) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAP))-1 ) = PACK(InData%SHAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPS))-1 ) = PACK(InData%SHAPS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GAUSSW))-1 ) = PACK(InData%GAUSSW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GAUSSW) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NGAUSS - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPT))-1 ) = PACK(InData%SHAPT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPT) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPTS))-1 ) = PACK(InData%SHAPTS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPTS) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTRAP - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SBEND))-1 ) = PACK(InData%SBEND,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SBEND) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%STEN))-1 ) = PACK(InData%STEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%STEN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMASS))-1 ) = PACK(InData%RMASS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMASS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RADDM))-1 ) = PACK(InData%RADDM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RADDM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMPN))-1 ) = PACK(InData%PMPN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMPN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AM))-1 ) = PACK(InData%AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PM))-1 ) = PACK(InData%PM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PM) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDOF))-1 ) = PACK(InData%IDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDOF) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%JDOF))-1 ) = PACK(InData%JDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%JDOF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PPA))-1 ) = PACK(InData%PPA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PPA) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) + DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) + DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SHAP,2), UBOUND(InData%SHAP,2) + DO i1 = LBOUND(InData%SHAP,1), UBOUND(InData%SHAP,1) + ReKiBuf(Re_Xferred) = InData%SHAP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%SHAPS,2), UBOUND(InData%SHAPS,2) + DO i1 = LBOUND(InData%SHAPS,1), UBOUND(InData%SHAPS,1) + ReKiBuf(Re_Xferred) = InData%SHAPS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%GAUSSW,1), UBOUND(InData%GAUSSW,1) + ReKiBuf(Re_Xferred) = InData%GAUSSW(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NGAUSS + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SHAPT,2), UBOUND(InData%SHAPT,2) + DO i1 = LBOUND(InData%SHAPT,1), UBOUND(InData%SHAPT,1) + ReKiBuf(Re_Xferred) = InData%SHAPT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%SHAPTS,2), UBOUND(InData%SHAPTS,2) + DO i1 = LBOUND(InData%SHAPTS,1), UBOUND(InData%SHAPTS,1) + ReKiBuf(Re_Xferred) = InData%SHAPTS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%NTRAP + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SBEND,2), UBOUND(InData%SBEND,2) + DO i1 = LBOUND(InData%SBEND,1), UBOUND(InData%SBEND,1) + ReKiBuf(Re_Xferred) = InData%SBEND(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i3 = LBOUND(InData%STEN,3), UBOUND(InData%STEN,3) + DO i2 = LBOUND(InData%STEN,2), UBOUND(InData%STEN,2) + DO i1 = LBOUND(InData%STEN,1), UBOUND(InData%STEN,1) + ReKiBuf(Re_Xferred) = InData%STEN(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i2 = LBOUND(InData%RMASS,2), UBOUND(InData%RMASS,2) + DO i1 = LBOUND(InData%RMASS,1), UBOUND(InData%RMASS,1) + ReKiBuf(Re_Xferred) = InData%RMASS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i4 = LBOUND(InData%RADDM,4), UBOUND(InData%RADDM,4) + DO i3 = LBOUND(InData%RADDM,3), UBOUND(InData%RADDM,3) + DO i2 = LBOUND(InData%RADDM,2), UBOUND(InData%RADDM,2) + DO i1 = LBOUND(InData%RADDM,1), UBOUND(InData%RADDM,1) + ReKiBuf(Re_Xferred) = InData%RADDM(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + DO i2 = LBOUND(InData%PMPN,2), UBOUND(InData%PMPN,2) + DO i1 = LBOUND(InData%PMPN,1), UBOUND(InData%PMPN,1) + ReKiBuf(Re_Xferred) = InData%PMPN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%AM,1), UBOUND(InData%AM,1) + ReKiBuf(Re_Xferred) = InData%AM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) + ReKiBuf(Re_Xferred) = InData%PM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%IDOF,2), UBOUND(InData%IDOF,2) + DO i1 = LBOUND(InData%IDOF,1), UBOUND(InData%IDOF,1) + IntKiBuf(Int_Xferred) = InData%IDOF(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%JDOF,1), UBOUND(InData%JDOF,1) + IntKiBuf(Int_Xferred) = InData%JDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i3 = LBOUND(InData%PPA,3), UBOUND(InData%PPA,3) + DO i2 = LBOUND(InData%PPA,2), UBOUND(InData%PPA,2) + DO i1 = LBOUND(InData%PPA,1), UBOUND(InData%PPA,1) + ReKiBuf(Re_Xferred) = InData%PPA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5596,10 +5602,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%GLUZR) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5616,8 +5622,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLUZR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLUZR))-1 ) = PACK(InData%GLUZR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLUZR) + DO i3 = LBOUND(InData%GLUZR,3), UBOUND(InData%GLUZR,3) + DO i2 = LBOUND(InData%GLUZR,2), UBOUND(InData%GLUZR,2) + DO i1 = LBOUND(InData%GLUZR,1), UBOUND(InData%GLUZR,1) + ReKiBuf(Re_Xferred) = InData%GLUZR(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GTZER) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5632,8 +5644,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GTZER)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GTZER))-1 ) = PACK(InData%GTZER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GTZER) + DO i2 = LBOUND(InData%GTZER,2), UBOUND(InData%GTZER,2) + DO i1 = LBOUND(InData%GTZER,1), UBOUND(InData%GTZER,1) + ReKiBuf(Re_Xferred) = InData%GTZER(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_PackParam @@ -5650,12 +5666,6 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5673,31 +5683,26 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%GRAV,1) i1_u = UBOUND(OutData%GRAV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GRAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GRAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GRAV) - DEALLOCATE(mask1) - OutData%Eps = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NHBD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDIM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%GRAV,1), UBOUND(OutData%GRAV,1) + OutData%GRAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Eps = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NHBD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDIM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NEQ not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5711,24 +5716,19 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NEQ)>0) OutData%NEQ = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NEQ))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NEQ) - DEALLOCATE(mask1) - END IF - OutData%NBAND = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NEQ,1), UBOUND(OutData%NEQ,1) + OutData%NEQ(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NBAND = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumElems = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5748,15 +5748,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GSL)>0) OutData%GSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) + DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) + DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) + OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GP not allocated Int_Xferred = Int_Xferred + 1 @@ -5774,15 +5773,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GP)>0) OutData%GP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GP,2), UBOUND(OutData%GP,2) + DO i1 = LBOUND(OutData%GP,1), UBOUND(OutData%GP,1) + OutData%GP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elength not allocated Int_Xferred = Int_Xferred + 1 @@ -5797,15 +5793,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Elength)>0) OutData%Elength = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Elength))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Elength) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Elength,1), UBOUND(OutData%Elength,1) + OutData%Elength(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmElev not allocated Int_Xferred = Int_Xferred + 1 @@ -5820,15 +5811,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmElev)>0) OutData%BottmElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmElev,1), UBOUND(OutData%BottmElev,1) + OutData%BottmElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -5843,15 +5829,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmStiff)>0) OutData%BottmStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) + OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5866,15 +5847,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LMassDen)>0) OutData%LMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) + OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5889,15 +5865,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDMassDen)>0) OutData%LDMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) + OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -5912,15 +5883,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LEAStiff)>0) OutData%LEAStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LEAStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LEAStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) + OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated Int_Xferred = Int_Xferred + 1 @@ -5935,15 +5901,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCI)>0) OutData%LineCI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) + OutData%LineCI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated Int_Xferred = Int_Xferred + 1 @@ -5958,15 +5919,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCD)>0) OutData%LineCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) + OutData%LineCD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bvp not allocated Int_Xferred = Int_Xferred + 1 @@ -5984,15 +5940,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Bvp)>0) OutData%Bvp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Bvp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Bvp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Bvp,2), UBOUND(OutData%Bvp,2) + DO i1 = LBOUND(OutData%Bvp,1), UBOUND(OutData%Bvp,1) + OutData%Bvp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 @@ -6013,15 +5966,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc0)>0) OutData%WaveAcc0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) + DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) + DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) + OutData%WaveAcc0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -6036,15 +5988,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -6065,126 +6012,101 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel0)>0) OutData%WaveVel0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) + DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) + DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) + OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SHAP,1) i1_u = UBOUND(OutData%SHAP,1) i2_l = LBOUND(OutData%SHAP,2) i2_u = UBOUND(OutData%SHAP,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAP,2), UBOUND(OutData%SHAP,2) + DO i1 = LBOUND(OutData%SHAP,1), UBOUND(OutData%SHAP,1) + OutData%SHAP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%SHAPS,1) i1_u = UBOUND(OutData%SHAPS,1) i2_l = LBOUND(OutData%SHAPS,2) i2_u = UBOUND(OutData%SHAPS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAPS,2), UBOUND(OutData%SHAPS,2) + DO i1 = LBOUND(OutData%SHAPS,1), UBOUND(OutData%SHAPS,1) + OutData%SHAPS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%GAUSSW,1) i1_u = UBOUND(OutData%GAUSSW,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GAUSSW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GAUSSW))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GAUSSW) - DEALLOCATE(mask1) - OutData%NGAUSS = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%GAUSSW,1), UBOUND(OutData%GAUSSW,1) + OutData%GAUSSW(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NGAUSS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SHAPT,1) i1_u = UBOUND(OutData%SHAPT,1) i2_l = LBOUND(OutData%SHAPT,2) i2_u = UBOUND(OutData%SHAPT,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAPT,2), UBOUND(OutData%SHAPT,2) + DO i1 = LBOUND(OutData%SHAPT,1), UBOUND(OutData%SHAPT,1) + OutData%SHAPT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%SHAPTS,1) i1_u = UBOUND(OutData%SHAPTS,1) i2_l = LBOUND(OutData%SHAPTS,2) i2_u = UBOUND(OutData%SHAPTS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPTS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPTS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPTS) - DEALLOCATE(mask2) - OutData%NTRAP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%SHAPTS,2), UBOUND(OutData%SHAPTS,2) + DO i1 = LBOUND(OutData%SHAPTS,1), UBOUND(OutData%SHAPTS,1) + OutData%SHAPTS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%NTRAP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SBEND,1) i1_u = UBOUND(OutData%SBEND,1) i2_l = LBOUND(OutData%SBEND,2) i2_u = UBOUND(OutData%SBEND,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SBEND = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SBEND))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SBEND) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SBEND,2), UBOUND(OutData%SBEND,2) + DO i1 = LBOUND(OutData%SBEND,1), UBOUND(OutData%SBEND,1) + OutData%SBEND(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%STEN,1) i1_u = UBOUND(OutData%STEN,1) i2_l = LBOUND(OutData%STEN,2) i2_u = UBOUND(OutData%STEN,2) i3_l = LBOUND(OutData%STEN,3) i3_u = UBOUND(OutData%STEN,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%STEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%STEN))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%STEN) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%STEN,3), UBOUND(OutData%STEN,3) + DO i2 = LBOUND(OutData%STEN,2), UBOUND(OutData%STEN,2) + DO i1 = LBOUND(OutData%STEN,1), UBOUND(OutData%STEN,1) + OutData%STEN(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%RMASS,1) i1_u = UBOUND(OutData%RMASS,1) i2_l = LBOUND(OutData%RMASS,2) i2_u = UBOUND(OutData%RMASS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RMASS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMASS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMASS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RMASS,2), UBOUND(OutData%RMASS,2) + DO i1 = LBOUND(OutData%RMASS,1), UBOUND(OutData%RMASS,1) + OutData%RMASS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RADDM,1) i1_u = UBOUND(OutData%RADDM,1) i2_l = LBOUND(OutData%RADDM,2) @@ -6193,97 +6115,76 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs i3_u = UBOUND(OutData%RADDM,3) i4_l = LBOUND(OutData%RADDM,4) i4_u = UBOUND(OutData%RADDM,4) - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - OutData%RADDM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RADDM))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RADDM) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%RADDM,4), UBOUND(OutData%RADDM,4) + DO i3 = LBOUND(OutData%RADDM,3), UBOUND(OutData%RADDM,3) + DO i2 = LBOUND(OutData%RADDM,2), UBOUND(OutData%RADDM,2) + DO i1 = LBOUND(OutData%RADDM,1), UBOUND(OutData%RADDM,1) + OutData%RADDM(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO i1_l = LBOUND(OutData%PMPN,1) i1_u = UBOUND(OutData%PMPN,1) i2_l = LBOUND(OutData%PMPN,2) i2_u = UBOUND(OutData%PMPN,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PMPN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMPN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMPN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMPN,2), UBOUND(OutData%PMPN,2) + DO i1 = LBOUND(OutData%PMPN,1), UBOUND(OutData%PMPN,1) + OutData%PMPN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AM,1) i1_u = UBOUND(OutData%AM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AM,1), UBOUND(OutData%AM,1) + OutData%AM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PM,1) i1_u = UBOUND(OutData%PM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) + OutData%PM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%IDOF,1) i1_u = UBOUND(OutData%IDOF,1) i2_l = LBOUND(OutData%IDOF,2) i2_u = UBOUND(OutData%IDOF,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%IDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDOF))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDOF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%IDOF,2), UBOUND(OutData%IDOF,2) + DO i1 = LBOUND(OutData%IDOF,1), UBOUND(OutData%IDOF,1) + OutData%IDOF(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%JDOF,1) i1_u = UBOUND(OutData%JDOF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%JDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%JDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%JDOF,1), UBOUND(OutData%JDOF,1) + OutData%JDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%PPA,1) i1_u = UBOUND(OutData%PPA,1) i2_l = LBOUND(OutData%PPA,2) i2_u = UBOUND(OutData%PPA,2) i3_l = LBOUND(OutData%PPA,3) i3_u = UBOUND(OutData%PPA,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%PPA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PPA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PPA) - DEALLOCATE(mask3) - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(OutData%PPA,3), UBOUND(OutData%PPA,3) + DO i2 = LBOUND(OutData%PPA,2), UBOUND(OutData%PPA,2) + DO i1 = LBOUND(OutData%PPA,1), UBOUND(OutData%PPA,1) + OutData%PPA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6340,10 +6241,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLUZR not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6363,15 +6264,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GLUZR)>0) OutData%GLUZR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLUZR))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLUZR) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GLUZR,3), UBOUND(OutData%GLUZR,3) + DO i2 = LBOUND(OutData%GLUZR,2), UBOUND(OutData%GLUZR,2) + DO i1 = LBOUND(OutData%GLUZR,1), UBOUND(OutData%GLUZR,1) + OutData%GLUZR(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GTZER not allocated Int_Xferred = Int_Xferred + 1 @@ -6389,15 +6289,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GTZER)>0) OutData%GTZER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GTZER))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GTZER) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GTZER,2), UBOUND(OutData%GTZER,2) + DO i1 = LBOUND(OutData%GTZER,1), UBOUND(OutData%GTZER,1) + OutData%GTZER(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_UnPackParam @@ -6604,12 +6501,6 @@ SUBROUTINE FEAM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInput' @@ -6868,8 +6759,10 @@ SUBROUTINE FEAM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6942,12 +6835,6 @@ SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6975,15 +6862,10 @@ SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7142,8 +7024,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -7158,6 +7040,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) @@ -7191,8 +7075,9 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp2' @@ -7214,6 +7099,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) @@ -7295,12 +7182,12 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7313,13 +7200,13 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -7354,13 +7241,14 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7379,14 +7267,14 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) diff --git a/modules/hydrodyn/CMakeLists.txt b/modules/hydrodyn/CMakeLists.txt index a6670716fa..5626c445fb 100644 --- a/modules/hydrodyn/CMakeLists.txt +++ b/modules/hydrodyn/CMakeLists.txt @@ -20,6 +20,7 @@ if (GENERATE_TYPES) generate_f90_types(src/HydroDyn.txt ${CMAKE_CURRENT_LIST_DIR}/src/HydroDyn_Types.f90) generate_f90_types(src/Morison.txt ${CMAKE_CURRENT_LIST_DIR}/src/Morison_Types.f90) generate_f90_types(src/SS_Radiation.txt ${CMAKE_CURRENT_LIST_DIR}/src/SS_Radiation_Types.f90) + generate_f90_types(src/SS_Excitation.txt ${CMAKE_CURRENT_LIST_DIR}/src/SS_Excitation_Types.f90) generate_f90_types(src/WAMIT.txt ${CMAKE_CURRENT_LIST_DIR}/src/WAMIT_Types.f90) generate_f90_types(src/WAMIT2.txt ${CMAKE_CURRENT_LIST_DIR}/src/WAMIT2_Types.f90) generate_f90_types(src/Waves.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves_Types.f90) @@ -35,6 +36,7 @@ set(HYDRODYN_SOURCES src/Morison.f90 src/Morison_Output.f90 src/SS_Radiation.f90 + src/SS_Excitation.f90 src/UserWaves.f90 src/WAMIT.f90 src/WAMIT2.f90 @@ -49,6 +51,7 @@ set(HYDRODYN_SOURCES src/HydroDyn_Types.f90 src/Morison_Types.f90 src/SS_Radiation_Types.f90 + src/SS_Excitation_Types.f90 src/WAMIT_Types.f90 src/WAMIT2_Types.f90 src/Waves_Types.f90 diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index e5dd8d3382..cbbf1b3868 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -268,18 +268,18 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RdtnDTChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HighFreq - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%RdtnDT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RdtnDTChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%HighFreq + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%HdroAddMs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -293,8 +293,12 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroAddMs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroAddMs))-1 ) = PACK(InData%HdroAddMs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroAddMs) + DO i2 = LBOUND(InData%HdroAddMs,2), UBOUND(InData%HdroAddMs,2) + DO i1 = LBOUND(InData%HdroAddMs,1), UBOUND(InData%HdroAddMs,1) + ReKiBuf(Re_Xferred) = InData%HdroAddMs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%HdroFreq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -306,8 +310,10 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroFreq,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroFreq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroFreq))-1 ) = PACK(InData%HdroFreq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroFreq) + DO i1 = LBOUND(InData%HdroFreq,1), UBOUND(InData%HdroFreq,1) + ReKiBuf(Re_Xferred) = InData%HdroFreq(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HdroDmpng) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -322,15 +328,19 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroDmpng)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroDmpng))-1 ) = PACK(InData%HdroDmpng,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroDmpng) + DO i2 = LBOUND(InData%HdroDmpng,2), UBOUND(InData%HdroDmpng,2) + DO i1 = LBOUND(InData%HdroDmpng,1), UBOUND(InData%HdroDmpng,1) + ReKiBuf(Re_Xferred) = InData%HdroDmpng(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NInpFreq - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NInpFreq + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackInitInput SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -346,12 +356,6 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -368,18 +372,18 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%RdtnDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RdtnDTChr) - OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HighFreq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%RdtnDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RdtnDTChr) + OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%HighFreq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAddMs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -396,15 +400,12 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%HdroAddMs)>0) OutData%HdroAddMs = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroAddMs))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroAddMs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroAddMs,2), UBOUND(OutData%HdroAddMs,2) + DO i1 = LBOUND(OutData%HdroAddMs,1), UBOUND(OutData%HdroAddMs,1) + OutData%HdroAddMs(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroFreq not allocated Int_Xferred = Int_Xferred + 1 @@ -419,15 +420,10 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HdroFreq)>0) OutData%HdroFreq = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroFreq))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroFreq) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HdroFreq,1), UBOUND(OutData%HdroFreq,1) + OutData%HdroFreq(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroDmpng not allocated Int_Xferred = Int_Xferred + 1 @@ -445,22 +441,19 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%HdroDmpng)>0) OutData%HdroDmpng = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroDmpng))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroDmpng) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroDmpng,2), UBOUND(OutData%HdroDmpng,2) + DO i1 = LBOUND(OutData%HdroDmpng,1), UBOUND(OutData%HdroDmpng,1) + OutData%HdroDmpng(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NInpFreq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NInpFreq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RdtnTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackInitInput SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -554,8 +547,8 @@ SUBROUTINE Conv_Rdtn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyInitOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyInitOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackInitOutput SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -571,12 +564,6 @@ SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' @@ -590,8 +577,8 @@ SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyInitOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackInitOutput SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -685,8 +672,8 @@ SUBROUTINE Conv_Rdtn_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackContState SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -702,12 +689,6 @@ SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackContState' @@ -721,8 +702,8 @@ SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackContState SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -853,11 +834,15 @@ SUBROUTINE Conv_Rdtn_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XDHistory)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XDHistory))-1 ) = PACK(InData%XDHistory,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XDHistory) + DO i2 = LBOUND(InData%XDHistory,2), UBOUND(InData%XDHistory,2) + DO i1 = LBOUND(InData%XDHistory,1), UBOUND(InData%XDHistory,1) + ReKiBuf(Re_Xferred) = InData%XDHistory(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTime - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTime + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackDiscState SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -873,12 +858,6 @@ SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -910,18 +889,15 @@ SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XDHistory)>0) OutData%XDHistory = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XDHistory))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XDHistory) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XDHistory,2), UBOUND(OutData%XDHistory,2) + DO i1 = LBOUND(OutData%XDHistory,1), UBOUND(OutData%XDHistory,1) + OutData%XDHistory(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%LastTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackDiscState SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1015,8 +991,8 @@ SUBROUTINE Conv_Rdtn_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackConstrState SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1032,12 +1008,6 @@ SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackConstrState' @@ -1051,8 +1021,8 @@ SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackConstrState SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1146,8 +1116,8 @@ SUBROUTINE Conv_Rdtn_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IndRdtn - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IndRdtn + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackOtherState SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1163,12 +1133,6 @@ SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackOtherState' @@ -1182,8 +1146,8 @@ SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IndRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IndRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackOtherState SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1277,8 +1241,8 @@ SUBROUTINE Conv_Rdtn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndRdtn - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndRdtn + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackMisc SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1294,12 +1258,6 @@ SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackMisc' @@ -1313,8 +1271,8 @@ SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackMisc SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1441,10 +1399,10 @@ SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnDT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RdtnKrnl) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1461,13 +1419,19 @@ SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RdtnKrnl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RdtnKrnl))-1 ) = PACK(InData%RdtnKrnl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RdtnKrnl) + DO i3 = LBOUND(InData%RdtnKrnl,3), UBOUND(InData%RdtnKrnl,3) + DO i2 = LBOUND(InData%RdtnKrnl,2), UBOUND(InData%RdtnKrnl,2) + DO i1 = LBOUND(InData%RdtnKrnl,1), UBOUND(InData%RdtnKrnl,1) + ReKiBuf(Re_Xferred) = InData%RdtnKrnl(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepRdtn - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepRdtn1 - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepRdtn + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepRdtn1 + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackParam SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1483,12 +1447,6 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1505,10 +1463,10 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%RdtnDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%RdtnDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RdtnKrnl not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1528,20 +1486,19 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RdtnKrnl)>0) OutData%RdtnKrnl = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RdtnKrnl))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%RdtnKrnl) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RdtnKrnl,3), UBOUND(OutData%RdtnKrnl,3) + DO i2 = LBOUND(OutData%RdtnKrnl,2), UBOUND(OutData%RdtnKrnl,2) + DO i1 = LBOUND(OutData%RdtnKrnl,1), UBOUND(OutData%RdtnKrnl,1) + OutData%RdtnKrnl(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%NStepRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepRdtn1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepRdtn1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackParam SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,8 +1593,10 @@ SUBROUTINE Conv_Rdtn_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Velocity))-1 ) = PACK(InData%Velocity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Velocity) + DO i1 = LBOUND(InData%Velocity,1), UBOUND(InData%Velocity,1) + ReKiBuf(Re_Xferred) = InData%Velocity(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_PackInput SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1653,12 +1612,6 @@ SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1675,15 +1628,10 @@ SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%Velocity,1) i1_u = UBOUND(OutData%Velocity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Velocity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Velocity))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Velocity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Velocity,1), UBOUND(OutData%Velocity,1) + OutData%Velocity(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_UnPackInput SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1778,8 +1726,10 @@ SUBROUTINE Conv_Rdtn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Rdtn))-1 ) = PACK(InData%F_Rdtn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Rdtn) + DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) + ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_PackOutput SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1795,12 +1745,6 @@ SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1817,15 +1761,10 @@ SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%F_Rdtn,1) i1_u = UBOUND(OutData%F_Rdtn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Rdtn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Rdtn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Rdtn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) + OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_UnPackOutput @@ -1903,12 +1842,12 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1921,12 +1860,12 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%Velocity,1))) - ALLOCATE(c1(SIZE(u_out%Velocity,1))) - b1 = -(u1%Velocity - u2%Velocity)/t(2) - u_out%Velocity = u1%Velocity + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) + b = -(u1%Velocity(i1) - u2%Velocity(i1)) + u_out%Velocity(i1) = u1%Velocity(i1) + b * ScaleFactor + END DO END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1 @@ -1956,13 +1895,14 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1981,13 +1921,13 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%Velocity,1))) - ALLOCATE(c1(SIZE(u_out%Velocity,1))) - b1 = (t(3)**2*(u1%Velocity - u2%Velocity) + t(2)**2*(-u1%Velocity + u3%Velocity))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Velocity + t(3)*u2%Velocity - t(2)*u3%Velocity ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Velocity = u1%Velocity + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) + b = (t(3)**2*(u1%Velocity(i1) - u2%Velocity(i1)) + t(2)**2*(-u1%Velocity(i1) + u3%Velocity(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Velocity(i1) + t(3)*u2%Velocity(i1) - t(2)*u3%Velocity(i1) ) * scaleFactor + u_out%Velocity(i1) = u1%Velocity(i1) + b + c * t_out + END DO END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2 @@ -2065,12 +2005,12 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2083,12 +2023,12 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%F_Rdtn,1))) - ALLOCATE(c1(SIZE(y_out%F_Rdtn,1))) - b1 = -(y1%F_Rdtn - y2%F_Rdtn)/t(2) - y_out%F_Rdtn = y1%F_Rdtn + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) + b = -(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b * ScaleFactor + END DO END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1 @@ -2118,13 +2058,14 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2143,13 +2084,13 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%F_Rdtn,1))) - ALLOCATE(c1(SIZE(y_out%F_Rdtn,1))) - b1 = (t(3)**2*(y1%F_Rdtn - y2%F_Rdtn) + t(2)**2*(-y1%F_Rdtn + y3%F_Rdtn))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%F_Rdtn + t(3)*y2%F_Rdtn - t(2)*y3%F_Rdtn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%F_Rdtn = y1%F_Rdtn + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) + b = (t(3)**2*(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + t(2)**2*(-y1%F_Rdtn(i1) + y3%F_Rdtn(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%F_Rdtn(i1) + t(3)*y2%F_Rdtn(i1) - t(2)*y3%F_Rdtn(i1) ) * scaleFactor + y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b + c * t_out + END DO END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2 END MODULE Conv_Radiation_Types diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 index a6e1405853..f262434bca 100644 --- a/modules/hydrodyn/src/Current_Types.f90 +++ b/modules/hydrodyn/src/Current_Types.f90 @@ -233,28 +233,28 @@ SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrSSV0 - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%CurrSSDirChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrSSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSRef - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSV0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrDIV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrDIDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CurrMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrSSV0 + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%CurrSSDirChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%CurrSSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSRef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSV0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CurrMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MorisonNodezi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -265,15 +265,17 @@ SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonNodezi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MorisonNodezi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MorisonNodezi))-1 ) = PACK(InData%MorisonNodezi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MorisonNodezi) + DO i1 = LBOUND(InData%MorisonNodezi,1), UBOUND(InData%MorisonNodezi,1) + ReKiBuf(Re_Xferred) = InData%MorisonNodezi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMorisonNodes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NMorisonNodes + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Current_PackInitInput SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -289,12 +291,6 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -309,28 +305,28 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%CurrSSV0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%CurrSSDirChr) - OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrSSDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSRef = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSV0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIV = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%CurrSSDirChr) + OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonNodezi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -344,22 +340,17 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MorisonNodezi)>0) OutData%MorisonNodezi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MorisonNodezi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%MorisonNodezi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MorisonNodezi,1), UBOUND(OutData%MorisonNodezi,1) + OutData%MorisonNodezi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NMorisonNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NMorisonNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Current_UnPackInitInput SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -506,8 +497,10 @@ SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVxi))-1 ) = PACK(InData%CurrVxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVxi) + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -519,13 +512,15 @@ SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVyi))-1 ) = PACK(InData%CurrVyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVyi) + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackInitOutput SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -541,12 +536,6 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -574,15 +563,10 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVxi)>0) OutData%CurrVxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated Int_Xferred = Int_Xferred + 1 @@ -597,20 +581,15 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVyi)>0) OutData%CurrVyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%PCurrVxiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackInitOutput SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -704,8 +683,8 @@ SUBROUTINE Current_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackContState SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -721,12 +700,6 @@ SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackContState' @@ -740,8 +713,8 @@ SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackContState SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -835,8 +808,8 @@ SUBROUTINE Current_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackDiscState SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -852,12 +825,6 @@ SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackDiscState' @@ -871,8 +838,8 @@ SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackDiscState SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -966,8 +933,8 @@ SUBROUTINE Current_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackConstrState SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -983,12 +950,6 @@ SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackConstrState' @@ -1002,8 +963,8 @@ SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackConstrState SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1097,8 +1058,8 @@ SUBROUTINE Current_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Current_PackOtherState SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1114,12 +1075,6 @@ SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOtherState' @@ -1133,8 +1088,8 @@ SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Current_UnPackOtherState SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1228,8 +1183,8 @@ SUBROUTINE Current_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackMisc SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1245,12 +1200,6 @@ SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackMisc' @@ -1264,8 +1213,8 @@ SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackMisc SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1359,8 +1308,8 @@ SUBROUTINE Current_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Current_PackParam SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1376,12 +1325,6 @@ SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackParam' @@ -1395,8 +1338,8 @@ SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Current_UnPackParam SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1490,8 +1433,8 @@ SUBROUTINE Current_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackInput SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1507,12 +1450,6 @@ SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInput' @@ -1526,8 +1463,8 @@ SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackInput SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1621,8 +1558,8 @@ SUBROUTINE Current_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackOutput SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1638,12 +1575,6 @@ SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOutput' @@ -1657,8 +1588,8 @@ SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOutput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackOutput @@ -1736,8 +1667,8 @@ SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -1752,8 +1683,10 @@ SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Current_Input_ExtrapInterp1 @@ -1783,8 +1716,9 @@ SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp2' @@ -1806,9 +1740,11 @@ SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Current_Input_ExtrapInterp2 @@ -1886,8 +1822,8 @@ SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -1902,8 +1838,10 @@ SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor END SUBROUTINE Current_Output_ExtrapInterp1 @@ -1933,8 +1871,9 @@ SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp2' @@ -1956,9 +1895,11 @@ SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out END SUBROUTINE Current_Output_ExtrapInterp2 END MODULE Current_Types diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 16702a738c..9f1b60fb8e 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -60,6 +60,18 @@ MODULE HydroDyn PUBLIC :: HydroDyn_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states !PUBLIC :: HydroDyn_UpdateDiscState ! Tight coupling routine for updating discrete states + PUBLIC :: HD_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u) + PUBLIC :: HD_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the continuous + ! states(x) + PUBLIC :: HD_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the discrete + ! states(xd) + PUBLIC :: HD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the constraint + ! states(z) + PUBLIC :: HD_GetOP !< Routine to pack the operating point values (for linearization) into arrays CONTAINS @@ -302,7 +314,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Init' @@ -377,13 +389,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! we will set Hydrodyn's time step to be that of the Convolution radiation module if it is being used. Otherwise, we ! will set it to be equal to the glue-codes IF ((Initlocal%PotMod == 1) .AND. (Initlocal%WAMIT%RdtnMod == 1) ) THEN - IF ( .NOT. EqualRealNos(Interval,InitLocal%WAMIT%Conv_Rdtn%RdtnDT) ) THEN - CALL SetErrStat(ErrID_Fatal,'The value of RdtnDT is not equal to the glue code timestep. This is not allowed in the current version of HydroDyn.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END IF + p%DT = InitLocal%WAMIT%Conv_Rdtn%RdtnDT @@ -846,8 +852,13 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InitLocal%WAMIT%NStepWave2 = Waves_InitOut%NStepWave2 InitLocal%WAMIT%WaveDirMin = Waves_InitOut%WaveDirMin InitLocal%WAMIT%WaveDirMax = Waves_InitOut%WaveDirMax - InitLocal%WAMIT%WaveDOmega = Waves_InitOut%WaveDOmega - + InitLocal%WAMIT%WaveDOmega = Waves_InitOut%WaveDOmega + + + ! Init inputs for the SS_Excitation model (set this just in case it will be used) + InitLocal%WAMIT%WaveDir = Waves_InitOut%WaveDir + CALL MOVE_ALLOC(Waves_InitOut%WaveElev0, InitLocal%WAMIT%WaveElev0) + ! Temporarily move arrays to init input for WAMIT (save some space) CALL MOVE_ALLOC(p%WaveTime, InitLocal%WAMIT%WaveTime) CALL MOVE_ALLOC(Waves_InitOut%WaveElevC0, InitLocal%WAMIT%WaveElevC0) @@ -865,6 +876,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF + + ! Generate Summary file information for WAMIT module ! Compute the load contribution from hydrostatics: IF ( InitLocal%UnSum > 0 ) THEN @@ -1449,20 +1462,34 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - ! Define initialization-routine output here: - InitOut%Ver = HydroDyn_ProgDesc - ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: - InitOut%WtrDens = InitLocal%Morison%WtrDens - InitOut%WtrDpth = InitLocal%Morison%WtrDpth - InitOut%MSL2SWL = InitLocal%Morison%MSL2SWL - + ! Define initialization-routine output here: + InitOut%Ver = HydroDyn_ProgDesc + ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: + InitOut%WtrDens = InitLocal%Morison%WtrDens + InitOut%WtrDpth = InitLocal%Morison%WtrDpth + InitOut%MSL2SWL = InitLocal%Morison%MSL2SWL + + p%WtrDpth = InitOut%WtrDpth + IF ( InitInp%hasIce ) THEN IF ((InitLocal%Waves%WaveMod /= 0) .OR. (InitLocal%Current%CurrMod /= 0) ) THEN CALL SetErrStat(ErrID_Fatal,'Waves and Current must be turned off in HydroDyn when ice loading is computed. Set WaveMod=0 and CurrMod=0.',ErrStat,ErrMsg,RoutineName) END IF END IF - + !............................................................................................ + ! Initialize Jacobian: + !............................................................................................ + if (InitInp%Linearize) then + call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing + ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! + DEALLOCATE ( InitOut%WriteOutputHdr ) + END IF + ! Destroy the local initialization data CALL CleanUp() @@ -2131,7 +2158,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -2150,7 +2177,1189 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError END FUNCTION CalcLoadsAtWRP + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! ###### The following four routines are Jacobian routines for linearization capabilities ####### +! If the module does not implement them, set ErrStat = ErrID_Fatal in HD_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 HD_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(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with + !! respect to the inputs (u) [intent in to avoid deallocation] + + + ! local variables + TYPE(HydroDyn_OutputType) :: y_p + TYPE(HydroDyn_OutputType) :: y_m + TYPE(HydroDyn_ContinuousStateType) :: x_p + TYPE(HydroDyn_ContinuousStateType) :: x_m + TYPE(HydroDyn_InputType) :: u_perturb + REAL(R8Ki) :: delta ! delta change in input or state + INTEGER(IntKi) :: i, j, NN, offsetI, offsetJ + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + ! LIN_TODO: We need to deal with the case where either RdtnMod=0, and/or ExtcnMod=0 and hence %SS_Rdtn data or %SS_Exctn data is not valid + NN = p%WAMIT%SS_Rdtn%N + p%WAMIT%SS_Exctn%N + + ! make a copy of the inputs to perturb + call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + + + IF ( PRESENT( dYdu ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + + ! allocate dYdu if necessary + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+1, 'dYdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + do i=1,size(p%Jac_u_indx,1) + + ! get u_op + delta u + call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call HD_Perturb_u( p, i, 1, u_perturb, delta ) + + ! compute y at u_op + delta u + call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get u_op - delta u + call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call HD_Perturb_u( p, i, -1, u_perturb, delta ) + + ! compute y at u_op - delta u + call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get central difference: + call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) + + end do + + ! p%WaveElev0 column + dYdu(:,size(p%Jac_u_indx,1)+1) = 0 + + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + + + END IF + + + IF ( PRESENT( dXdu ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + + ! allocate dXdu if necessary + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, NN, size(p%Jac_u_indx,1)+1, 'dXdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + + offsetI = 0 + dXdu = 0.0_R8Ki + + + do i = 1,p%WAMIT%SS_Exctn%N + dXdu(offsetI+i,size(p%Jac_u_indx,1)+1) = p%WAMIT%SS_Exctn%B(i) + end do + + + offsetI = NN - p%WAMIT%SS_Rdtn%N + offsetJ = size(p%Jac_u_indx,1)+1 - 13 + do j = 1, 6 + do i = 1,p%WAMIT%SS_Rdtn%N + dXdu(offsetI+i,offsetJ+j) = p%WAMIT%SS_Rdtn%B(i,j) + end do + end do + + + + + END IF + + + + 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 + subroutine cleanup() + call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE HD_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 HD_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(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect + !! to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) with respect + !! to the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect + !! to the continuous states (x) [intent in to avoid deallocation] + + ! local variables + TYPE(HydroDyn_OutputType) :: y_p + TYPE(HydroDyn_OutputType) :: y_m + TYPE(HydroDyn_ContinuousStateType) :: x_p + TYPE(HydroDyn_ContinuousStateType) :: x_m + TYPE(HydroDyn_ContinuousStateType) :: x_perturb + REAL(R8Ki) :: delta ! delta change in input or state + INTEGER(IntKi) :: i, j, NN + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + NN = p%WAMIT%SS_Exctn%N+p%WAMIT%SS_Rdtn%N + + ! make a copy of the continuous states to perturb + call HydroDyn_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + IF ( PRESENT( dYdx ) ) THEN + + + ! allocate dYdx if necessary + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, p%Jac_ny, NN, 'dYdx', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + + do i=1,NN + + ! get x_op + delta x + call HydroDyn_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call HD_Perturb_x( p, i, 1, x_perturb, delta ) + + ! compute y at x_op + delta x + call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get x_op - delta x + call HydroDyn_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call HD_Perturb_x( p, i, -1, x_perturb, delta ) + + ! compute y at x_op - delta x + call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get central difference: + call Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) + + end do + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + + END IF + + IF ( PRESENT( dXdx ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + + ! allocate dXdu if necessary + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, NN, NN, 'dXdx', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + dXdx = 0.0_R8Ki + + ! Analytical Jacobians from State-space models + if ( p%WAMIT%SS_Exctn%N > 0 ) then + do j=1,p%WAMIT%SS_Exctn%N + do i=1,p%WAMIT%SS_Exctn%N ! Loop through all active (enabled) DOFs + dXdx(i, j) = p%WAMIT%SS_Exctn%A(i,j) + end do + end do + end if + if ( p%WAMIT%SS_Rdtn%N > 0 ) then + do j=1,p%WAMIT%SS_Rdtn%N + do i=1,p%WAMIT%SS_Rdtn%N ! Loop through all active (enabled) DOFs + dXdx(i+p%WAMIT%SS_Exctn%N, j+p%WAMIT%SS_Exctn%N) = p%WAMIT%SS_Rdtn%A(i,j) + end do + end do + end if + + 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 + subroutine cleanup() + call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE HD_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 HD_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(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions + !! (Y) with respect to the discrete + !! states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state + !! functions (X) with respect to the + !! discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state + !! functions (Xd) with respect to the + !! discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state + !! functions (Z) with respect to the + !! discrete states (xd) [intent in to avoid deallocation] + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + IF ( PRESENT( dYdxd ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: + + ! allocate and set dYdxd + + END IF + + IF ( PRESENT( dXdxd ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: + + ! allocate and set dXdxd + + END IF + + IF ( PRESENT( dXddxd ) ) THEN + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: + + ! allocate and set dXddxd + + END IF + + IF ( PRESENT( dZdxd ) ) THEN + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: + + ! allocate and set dZdxd + + END IF + + +END SUBROUTINE HD_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 HD_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(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_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(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous state functions (X) with respect + !! to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state functions (Xd) with respect + !! to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect + !! to the constraint states (z) [intent in to avoid deallocation] + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + IF ( PRESENT( dYdz ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: + + ! allocate and set dYdz + + END IF + + IF ( PRESENT( dXdz ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: + + ! allocate and set dXdz + + END IF + + IF ( PRESENT( dXddz ) ) THEN + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: + + ! allocate and set dXddz + + END IF + + IF ( PRESENT( dZdz ) ) THEN + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + + ! allocate and set dZdz + + END IF + + +END SUBROUTINE HD_JacobianPConstrState +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. +SUBROUTINE HD_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) + + TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y !< outputs + TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine + + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables: + INTEGER(IntKi) :: i,j,k, index_last, index_next + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_y' + LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + logical, allocatable :: AllOut(:) + + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! determine how many outputs there are in the Jacobians + p%Jac_ny = 0 + if ( y%Morison%DistribMesh%Committed ) then + p%Jac_ny = p%Jac_ny + y%Morison%DistribMesh%NNodes * 6 ! 3 Force, Moment, at each node on the distributed loads mesh + p%Jac_ny = p%Jac_ny + y%Morison%LumpedMesh%NNodes * 6 ! 3 Force, Moment, at each node on the lumped loads mesh + end if + + p%Jac_ny = p%Jac_ny + y%Mesh%NNodes * 6 ! 3 Force, Moment, at the WAMIT reference Point + p%Jac_ny = p%Jac_ny + y%AllHdroOrigin%NNodes * 6 ! 3 Force, Moment, of all HD loads integrated to the origin (0,0,0) + p%Jac_ny = p%Jac_ny + p%NumTotalOuts ! WriteOutput values + + + !................. + ! set linearization output names: + !................. + CALL AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! LIN-TODO: Do we need RotFrame_y for this module? + !CALL AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + + + + index_next = 1 + if ( y%Morison%DistribMesh%Committed ) then + index_last = index_next + call PackLoadMesh_Names(y%Morison%DistribMesh, 'DistribLoads', InitOut%LinNames_y, index_next) + index_last = index_next + call PackLoadMesh_Names(y%Morison%LumpedMesh, 'LumpedLoads', InitOut%LinNames_y, index_next) + end if + + + index_last = index_next + call PackLoadMesh_Names(y%Mesh, 'PlatformRefPtLoads', InitOut%LinNames_y, index_next) + + index_last = index_next + call PackLoadMesh_Names(y%AllHdroOrigin, 'AllHdroOrigin', InitOut%LinNames_y, index_next) + + index_last = index_next + + do i=1,p%NumTotalOuts + InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + end do + + + +END SUBROUTINE HD_Init_Jacobian_y + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. +SUBROUTINE HD_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) + + TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine + + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_x' + + ! local variables: + INTEGER(IntKi) :: i, j, k, NN, spdof, indx + CHARACTER(10) :: modLabels(2), dofLabels(6) + ErrStat = ErrID_None + ErrMsg = "" + indx = 1 + NN = p%WAMIT%SS_Rdtn%N + p%WAMIT%SS_Exctn%N + if ( NN == 0 ) return + ! allocate space for the row/column names and for perturbation sizes + call allocAry(p%dx, NN, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%LinNames_x, NN, 'LinNames_x', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(InitOut%DerivOrder_x, NN, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! All Hydrodyn continuous states are max order = 1 + if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 1 + ! set perturbation sizes: p%dx + + do i = 1, p%WAMIT%SS_Exctn%N + p%dx(i) = 20000.0_R8Ki * D2R_D + end do + + do i = 1, p%WAMIT%SS_Rdtn%N + p%dx(i+p%WAMIT%SS_Exctn%N) = 2.0_R8Ki * D2R_D + end do + + modLabels = (/'Exctn ','Rdtn '/) + dofLabels = (/'PtfmSg ','PtfmSw ','PtfmHv ','PtfmR ','PtfmP ','PtfmY '/) + + ! set linearization state names: + do k = 1, 2 ! 1 = Excitation, 2 = Radiation + + + do j = 1, 6 + + if (k == 1) then + spdof = p%WAMIT%SS_Exctn%spdof(j) + else + spdof = p%WAMIT%SS_Rdtn%spdof(j) + end if + + do i = 1,spdof + InitOut%LinNames_x(indx) = trim(modLabels(k))//trim(dofLabels(j))//trim(num2lstr(i)) + indx = indx + 1 + end do + end do + end do + +END SUBROUTINE HD_Init_Jacobian_x +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. +!! Do not change the order of this packing without changing corresponding linearization routines ! +SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) + + TYPE(HydroDyn_ParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(HydroDyn_InputType) , INTENT(IN ) :: u !< inputs + TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y !< outputs + TYPE(HydroDyn_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian' + + ! local variables: + INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField, m, meshFieldCount + REAL(R8Ki) :: MaxThrust, MaxTorque, perturb_t, perturb + REAL(R8Ki) :: ScaleLength + LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + + + + ErrStat = ErrID_None + ErrMsg = "" + + + call HD_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call HD_Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + + + ! determine how many inputs there are in the Jacobians + nu = 0; + if ( u%Morison%DistribMesh%Committed ) then + nu = nu + u%Morison%DistribMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node + nu = nu + u%Morison%LumpedMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node + end if + + nu = nu + u%Mesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node + + ! DO NOT Add the extended input WaveElev0 when computing the size of p%Jac_u_indx + + + ! note: all other inputs are ignored + + !.................... + ! fill matrix to store index to help us figure out what the ith value of the u vector really means + ! (see hydrodyn::HD_perturb_u ... these MUST match ) + ! column 1 indicates module's mesh and field + ! column 2 indicates the first index of the acceleration/load field + ! column 3 is the node + !.................... + + !............... + ! HD input mappings stored in p%Jac_u_indx: + !............... + call AllocAry(p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + index = 1 + meshFieldCount = 0 + if ( u%Morison%DistribMesh%Committed ) then + !Module/Mesh/Field: u%Morison%DistribMesh%TranslationDisp = 1; + !Module/Mesh/Field: u%Morison%DistribMesh%Orientation = 2; + !Module/Mesh/Field: u%Morison%DistribMesh%TranslationVel = 3; + !Module/Mesh/Field: u%Morison%DistribMesh%RotationVel = 4; + !Module/Mesh/Field: u%Morison%DistribMesh%TranslationAcc = 5; + !Module/Mesh/Field: u%Morison%DistribMesh%RotationAcc = 6; + + do i_meshField = 1,6 + do i=1,u%Morison%DistribMesh%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%Morison%DistribMesh%{TranslationDisp/Orientation/TranslationVel/RotationVel/TranslationAcc/RotationAcc} = m + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + + end do !i_meshField + meshFieldCount = 6 + !Module/Mesh/Field: u%Morison%LumpedMesh%TranslationDisp = 7; + !Module/Mesh/Field: u%Morison%LumpedMesh%Orientation = 8; + !Module/Mesh/Field: u%Morison%LumpedMesh%TranslationVel = 9; + !Module/Mesh/Field: u%Morison%LumpedMesh%RotationVel = 10; + !Module/Mesh/Field: u%Morison%LumpedMesh%TranslationAcc = 11; + !Module/Mesh/Field: u%Morison%LumpedMesh%RotationAcc = 12; + + do i_meshField = 1,6 + do i=1,u%Morison%LumpedMesh%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = meshFieldCount + i_meshField !if this mesh is allocated, then the previous DistribMesh would have been allocated + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + + end do !i_meshField + meshFieldCount = meshFieldCount + 6 + end if + + !Module/Mesh/Field: u%Mesh%TranslationDisp = 13 or 1; + !Module/Mesh/Field: u%Mesh%Orientation = 14 or 2; + !Module/Mesh/Field: u%Mesh%TranslationVel = 15 or 3; + !Module/Mesh/Field: u%Mesh%RotationVel = 16 or 4; + !Module/Mesh/Field: u%Mesh%TranslationAcc = 17 or 5; + !Module/Mesh/Field: u%Mesh%RotationAcc = 18 or 6; + + do i_meshField = 1,6 + do i=1,u%Mesh%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = meshFieldCount + i_meshField + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do !i_meshField + + + !................ + ! input perturbations, du: + !................ + if ( u%Morison%DistribMesh%Committed ) then + call AllocAry(p%du, 18, 'p%du', ErrStat2, ErrMsg2) ! number of unique values in p%Jac_u_indx(:,1) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + else + call AllocAry(p%du, 6, 'p%du', ErrStat2, ErrMsg2) ! number of unique values in p%Jac_u_indx(:,1) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + end if + + perturb_t = 0.02_ReKi*D2R * max(p%WtrDpth,1.0_ReKi) ! translation input scaling ! LIN-TODO What about MSL offset? + perturb = 2*D2R ! rotational input scaling + + index = 0 + if ( u%Morison%DistribMesh%Committed ) then + p%du(1) = perturb_t ! u%Morison%DistribMesh%TranslationDisp + p%du(2) = perturb ! u%Morison%DistribMesh%Orientation + p%du(3) = perturb_t ! u%Morison%DistribMesh%TranslationVel + p%du(4) = perturb ! u%Morison%DistribMesh%RotationVel + p%du(5) = perturb_t ! u%Morison%DistribMesh%TranslationAcc + p%du(6) = perturb ! u%Morison%DistribMesh%RotationAcc + index = 6 + p%du(index + 1) = perturb_t ! u%Morison%LumpedMesh%TranslationDisp + p%du(index + 2) = perturb ! u%Morison%LumpedMesh%Orientation + p%du(index + 3) = perturb_t ! u%Morison%LumpedMesh%TranslationVel + p%du(index + 4) = perturb ! u%Morison%LumpedMesh%RotationVel + p%du(index + 5) = perturb_t ! u%Morison%LumpedMesh%TranslationAcc + p%du(index + 6) = perturb ! u%Morison%LumpedMesh%RotationAcc + index = index + 6 + end if + + + p%du(index + 1) = perturb_t ! u%Mesh%TranslationDisp + p%du(index + 2) = perturb ! u%Mesh%Orientation + p%du(index + 3) = perturb_t ! u%Mesh%TranslationVel + p%du(index + 4) = perturb ! u%Mesh%RotationVel + p%du(index + 5) = perturb_t ! u%Mesh%TranslationAcc + p%du(index + 6) = perturb ! u%Mesh%RotationAcc + index = index + 6 + + + + !................ + ! names of the columns, InitOut%LinNames_u: + !................ + call AllocAry(InitOut%LinNames_u, nu+1, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !LIN-TODO: We do not need any RotFrame info, right? + !call AllocAry(InitOut%RotFrame_u, nu+1, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! LIN-TODO: have we implemented IsLoad_u ? + call AllocAry(InitOut%IsLoad_u, nu+1, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + InitOut%IsLoad_u = .false. ! HD's inputs are NOT loads + + index = 1 + if ( u%Morison%DistribMesh%Committed ) then + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + FieldMask(MASKID_ROTATIONACC) = .true. + call PackMotionMesh_Names(u%Morison%DistribMesh, 'Morison-Distrib', InitOut%LinNames_u, index, FieldMask=FieldMask) + + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_TRANSLATIONVel) = .true. + FieldMask(MASKID_ROTATIONVel) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + FieldMask(MASKID_ROTATIONACC) = .true. + call PackMotionMesh_Names(u%Morison%LumpedMesh, 'Morison-Lumped', InitOut%LinNames_u, index, FieldMask=FieldMask) + end if + + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_TRANSLATIONVel) = .true. + FieldMask(MASKID_ROTATIONVel) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + FieldMask(MASKID_ROTATIONACC) = .true. + call PackMotionMesh_Names(u%Mesh, 'Platform-RefPt', InitOut%LinNames_u, index, FieldMask=FieldMask) + + InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m' + +END SUBROUTINE HD_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 hydrodyn::HD_init_jacobian is consistant with this routine! +SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) + + TYPE(HydroDyn_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(HydroDyn_InputType) , INTENT(INOUT) :: u !< perturbed HD 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: + + ! If we do not have Morison meshes, then the following select cases will vary + if ( u%Morison%DistribMesh%Committed ) then + + SELECT CASE( p%Jac_u_indx(n,1) ) + CASE ( 1) !Module/Mesh/Field: u%Morison%DistribMesh%TranslationDisp = 1 + u%Morison%DistribMesh%TranslationDisp (fieldIndx,node) = u%Morison%DistribMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign + CASE ( 2) !Module/Mesh/Field: u%Morison%DistribMesh%Orientation = 2 + CALL PerturbOrientationMatrix( u%Morison%DistribMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + CASE ( 3) !Module/Mesh/Field: u%Morison%DistribMesh%TranslationVel = 3 + u%Morison%DistribMesh%TranslationVel( fieldIndx,node) = u%Morison%DistribMesh%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE ( 4) !Module/Mesh/Field: u%Morison%DistribMesh%RotationVel = 4 + u%Morison%DistribMesh%RotationVel (fieldIndx,node) = u%Morison%DistribMesh%RotationVel (fieldIndx,node) + du * perturb_sign + CASE ( 5) !Module/Mesh/Field: u%Morison%DistribMesh%TranslationAcc = 5 + u%Morison%DistribMesh%TranslationAcc( fieldIndx,node) = u%Morison%DistribMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE ( 6) !Module/Mesh/Field: u%Morison%DistribMesh%RotationAcc = 6 + u%Morison%DistribMesh%RotationAcc(fieldIndx,node) = u%Morison%DistribMesh%RotationAcc(fieldIndx,node) + du * perturb_sign + + CASE ( 7) !Module/Mesh/Field: u%Morison%LumpedMesh%TranslationDisp = 7 + u%Morison%LumpedMesh%TranslationDisp (fieldIndx,node) = u%Morison%LumpedMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign + CASE ( 8) !Module/Mesh/Field: u%Morison%LumpedMesh%Orientation = 8 + CALL PerturbOrientationMatrix( u%Morison%LumpedMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + CASE ( 9) !Module/Mesh/Field: u%Morison%LumpedMesh%TranslationVel = 9 + u%Morison%LumpedMesh%TranslationVel( fieldIndx,node) = u%Morison%LumpedMesh%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE (10) !Module/Mesh/Field: u%Morison%LumpedMesh%RotationVel = 10 + u%Morison%LumpedMesh%RotationVel (fieldIndx,node) = u%Morison%LumpedMesh%RotationVel (fieldIndx,node) + du * perturb_sign + CASE (11) !Module/Mesh/Field: u%Morison%LumpedMesh%TranslationAcc = 11 + u%Morison%LumpedMesh%TranslationAcc( fieldIndx,node) = u%Morison%LumpedMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE (12) !Module/Mesh/Field: u%Morison%LumpedMesh%RotationAcc = 12 + u%Morison%LumpedMesh%RotationAcc(fieldIndx,node) = u%Morison%LumpedMesh%RotationAcc(fieldIndx,node) + du * perturb_sign + + CASE (13) !Module/Mesh/Field: u%Mesh%TranslationDisp = 13 + u%Mesh%TranslationDisp (fieldIndx,node) = u%Mesh%TranslationDisp (fieldIndx,node) + du * perturb_sign + CASE (14) !Module/Mesh/Field: u%Mesh%Orientation = 14 + CALL PerturbOrientationMatrix( u%Mesh%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + CASE (15) !Module/Mesh/Field: u%Mesh%TranslationVel = 15 + u%Mesh%TranslationVel( fieldIndx,node) = u%Mesh%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE (16) !Module/Mesh/Field: u%Mesh%RotationVel = 16 + u%Mesh%RotationVel (fieldIndx,node) = u%Mesh%RotationVel (fieldIndx,node) + du * perturb_sign + CASE (17) !Module/Mesh/Field: u%Mesh%TranslationAcc = 17 + u%Mesh%TranslationAcc( fieldIndx,node) = u%Mesh%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE (18) !Module/Mesh/Field: u%Mesh%RotationAcc = 18 + u%Mesh%RotationAcc(fieldIndx,node) = u%Mesh%RotationAcc(fieldIndx,node) + du * perturb_sign + + + END SELECT + else + SELECT CASE( p%Jac_u_indx(n,1) ) + CASE (1) !Module/Mesh/Field: u%Mesh%TranslationDisp = 13 + u%Mesh%TranslationDisp (fieldIndx,node) = u%Mesh%TranslationDisp (fieldIndx,node) + du * perturb_sign + CASE (2) !Module/Mesh/Field: u%Mesh%Orientation = 14 + CALL PerturbOrientationMatrix( u%Mesh%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + CASE (3) !Module/Mesh/Field: u%Mesh%TranslationVel = 15 + u%Mesh%TranslationVel( fieldIndx,node) = u%Mesh%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE (4) !Module/Mesh/Field: u%Mesh%RotationVel = 16 + u%Mesh%RotationVel (fieldIndx,node) = u%Mesh%RotationVel (fieldIndx,node) + du * perturb_sign + CASE (5) !Module/Mesh/Field: u%Mesh%TranslationAcc = 17 + u%Mesh%TranslationAcc( fieldIndx,node) = u%Mesh%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE (6) !Module/Mesh/Field: u%Mesh%RotationAcc = 18 + u%Mesh%RotationAcc(fieldIndx,node) = u%Mesh%RotationAcc(fieldIndx,node) + du * perturb_sign + + END SELECT + end if + + +END SUBROUTINE HD_Perturb_u +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the continuous state array. +!! Do not change this without making sure subroutine HD_init_jacobian is consistant with this routine! +SUBROUTINE HD_Perturb_x( p, n, perturb_sign, x, dx ) + + TYPE(HydroDyn_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(HydroDyn_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states + REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed + + + ! local variables + integer(intKi) :: indx + + dx = p%dx(n) + + if (n > p%WAMIT%SS_Exctn%N) then + indx = n - p%WAMIT%SS_Exctn%N + x%WAMIT%SS_Rdtn%x( indx ) = x%WAMIT%SS_Rdtn%x( indx ) + dx * perturb_sign + else + indx = n + x%WAMIT%SS_Exctn%x( indx ) = x%WAMIT%SS_Exctn%x( indx ) + dx * perturb_sign + end if + +END SUBROUTINE HD_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 hydrodyn::HD_init_jacobian is consistant with this routine! +SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) + + TYPE(HydroDyn_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_p !< HD outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) + TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_m !< HD outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) + REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta 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 x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ + + ! local variables: + + integer(IntKi) :: indx_first ! index indicating next value of dY to be filled + logical :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + integer(IntKi) :: k + + + + + indx_first = 1 + if ( y_p%Morison%DistribMesh%Committed ) then + call PackLoadMesh_dY(y_p%Morison%DistribMesh, y_m%Morison%DistribMesh, dY, indx_first) + call PackLoadMesh_dY(y_p%Morison%LumpedMesh , y_m%Morison%LumpedMesh , dY, indx_first) + end if + + call PackLoadMesh_dY(y_p%Mesh, y_m%Mesh, dY, indx_first) + call PackLoadMesh_dY(y_p%AllHdroOrigin, y_m%AllHdroOrigin, dY, indx_first) + + do k=1,p%NumTotalOuts + dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) + end do + + + + dY = dY / (2.0_R8Ki*delta) + +END SUBROUTINE Compute_dY + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to pack the data structures representing the operating points into arrays for linearization. +SUBROUTINE HD_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(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y !< Output at operating point + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + + + + INTEGER(IntKi) :: i, k, index, nu + INTEGER(IntKi) :: ny + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' + TYPE(HydroDyn_ContinuousStateType) :: dx !< derivative of continuous states at operating point + LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + !.................................. + IF ( PRESENT( u_op ) ) THEN + + if (.not. allocated(u_op)) then + + nu = size(p%Jac_u_indx,1) + + ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do + if ( u%Morison%DistribMesh%Committed ) then + nu = nu + u%Morison%DistribMesh%NNodes * 6 & ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node + + u%Morison%LumpedMesh%NNodes * 6 & ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node + + u%Mesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node + nu = nu + 1 ! Extended input + else + nu = nu + u%Mesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node + nu = nu + 1 ! Extended input + end if + + call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + + end if + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + Mask(MASKID_TRANSLATIONACC) = .true. + Mask(MASKID_ROTATIONACC) = .true. + + index = 1 + if ( u%Morison%DistribMesh%Committed ) then + call PackMotionMesh(u%Morison%DistribMesh, u_op, index, FieldMask=Mask) + call PackMotionMesh(u%Morison%LumpedMesh , u_op, index, FieldMask=Mask) + end if + + call PackMotionMesh(u%Mesh, u_op, index, FieldMask=Mask) + + ! extended input: + u_op(index) = 0.0_R8Ki !u%WaveElev0 + + + END IF + + !.................................. + if ( PRESENT( y_op ) ) then + + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + + index = 1 + if ( y%Morison%DistribMesh%Committed ) then + call PackLoadMesh(y%Morison%DistribMesh, y_op, index) + call PackLoadMesh(y%Morison%LumpedMesh , y_op, index) + end if + + call PackLoadMesh(y%Mesh, y_op, index) + call PackLoadMesh(y%AllHdroOrigin, y_op, index) + + index = index - 1 + do i=1,p%NumTotalOuts + y_op(i+index) = y%WriteOutput(i) + end do + + end if + + !.................................. + IF ( PRESENT( x_op ) ) THEN + + if (.not. allocated(x_op)) then + call AllocAry(x_op, p%WAMIT%SS_Exctn%N+p%WAMIT%SS_Rdtn%N,'x_op',ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + do i=1,p%WAMIT%SS_Exctn%N ! Loop through all DOFs + x_op(i) = x%WAMIT%SS_Exctn%x(i) + end do + do i=1,p%WAMIT%SS_Rdtn%N ! Loop through all DOFs + x_op(i+p%WAMIT%SS_Exctn%N) = x%WAMIT%SS_Rdtn%x(i) + end do + + END IF + + !.................................. + IF ( PRESENT( dx_op ) ) THEN + + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, p%WAMIT%SS_Exctn%N+p%WAMIT%SS_Rdtn%N,'dx_op',ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + call HydroDyn_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call HydroDyn_DestroyContState( dx, ErrStat2, ErrMsg2) + return + end if + + do i=1,p%WAMIT%SS_Exctn%N ! Loop through all DOFs + dx_op(i) = dx%WAMIT%SS_Exctn%x(i) + end do + do i=1,p%WAMIT%SS_Rdtn%N ! Loop through all DOFs + dx_op(i+p%WAMIT%SS_Exctn%N) = dx%WAMIT%SS_Rdtn%x(i) + end do + + call HydroDyn_DestroyContState( dx, ErrStat2, ErrMsg2) + + END IF + + !.................................. + IF ( PRESENT( xd_op ) ) THEN + END IF + + !.................................. + IF ( PRESENT( z_op ) ) THEN + END IF + +END SUBROUTINE HD_GetOP + + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE HydroDyn !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 92f08ee6d0..ca379172d8 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -1,4 +1,5 @@ ################################################################################################################################### +################################################################################################################################### # Registry for HydroDyn in the FAST Modularization Framework # This Registry file is used to create MODULE HydroDyn which contains all of the user-defined types needed in HydroDyn. # It also contains copy, destroy, pack, and unpack routines associated with each defined data types. @@ -18,6 +19,7 @@ usefrom Waves.txt usefrom Waves2.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt +usefrom SS_Excitation.txt usefrom WAMIT.txt usefrom WAMIT2.txt usefrom Morison.txt @@ -26,6 +28,7 @@ param HydroDyn/HydroDyn unused INTEGER typedef HydroDyn/HydroDyn InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the HydroDyn module" - typedef ^ ^ LOGICAL UseInputFile - - - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ ^ DbKi DT - - - "Supplied by Driver: Simulation time step" "(sec)" typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" @@ -59,11 +62,11 @@ typedef ^ ^ Morison_Ini typedef ^ ^ LOGICAL Echo - - - "Echo the input files to a file with the same name as the input but with a .echo extension [T/F]" - typedef ^ ^ INTEGER PotMod - - - "1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model" - typedef ^ ^ INTEGER NUserOutputs - - - "Number of Hydrodyn-level requested output channels" - -typedef ^ ^ CHARACTER(10) UserOutputs {:} - - "This should really be dimensioned with MaxOutPts" - +typedef ^ ^ CHARACTER(ChanLen) UserOutputs {:} - - "This should really be dimensioned with MaxOutPts" - typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files]" - typedef ^ ^ LOGICAL OutAll - - - "Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F]" - typedef ^ ^ INTEGER NumOuts - - - "The number of outputs for this module as requested in the input file" - -typedef ^ ^ CHARACTER(10) OutList {54} - - "The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts" - +typedef ^ ^ CHARACTER(ChanLen) OutList {54} - - "The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts" - typedef ^ ^ LOGICAL HDSum - - - "Generate a HydroDyn summary file [T/F]" - typedef ^ ^ INTEGER UnSum - - - "File unit for the HydroDyn summary file [-1 = no summary file]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - @@ -73,16 +76,21 @@ typedef ^ ^ CHARACTER(2 # Define outputs from the initialization routine here: # typedef ^ InitOutputType WAMIT_InitOutputType WAMIT - - - "Initialization output from the WAMIT module" - -typedef ^ InitOutputType WAMIT2_InitOutputType WAMIT2 - - - "Initialization output from the WAMIT2 module" - -typedef ^ InitOutputType Waves2_InitOutputType Waves2 - - - "Initialization output from the Waves2 module" - +typedef ^ ^ WAMIT2_InitOutputType WAMIT2 - - - "Initialization output from the WAMIT2 module" - +typedef ^ ^ Waves2_InitOutputType Waves2 - - - "Initialization output from the Waves2 module" - typedef ^ ^ Morison_InitOutputType Morison - - - "Initialization output from the Morison module" - -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - -typedef ^ ^ CHARACTER(10) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ SiKi WaveElevSeries {:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY." (m) typedef ^ ^ ProgDesc Ver - - - "Version of HydroDyn" typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" (m) +typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ InitOutputType INTEGER DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - # ..... HD_ModuleMapType .................................................................................................................... @@ -147,7 +155,6 @@ typedef ^ ^ Morison_Mis typedef ^ ^ WAMIT_InputType u_WAMIT - - - "WAMIT module inputs" - typedef ^ ^ WAMIT2_InputType u_WAMIT2 - - - "WAMIT2 module inputs" - typedef ^ ^ Waves2_InputType u_Waves2 - - - "Waves2 module inputs" - - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -163,6 +170,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElev {:}{:} - - "Total wave elevation" - typedef ^ ^ SiKi WaveElev1 {:}{:} - - "First order wave elevation" - +typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ ReKi AddF0 {6} - - "Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m)" - typedef ^ ^ ReKi AddCLin {6}{6} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {6}{6} - - "Additional linear damping matrix" - @@ -174,9 +182,13 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - -typedef ^ ^ CHARACTER(10) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the HydroDyn outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - +typedef ^ ^ Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ ^ R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" - +typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" - +typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index f913722706..09dc34dd3c 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -36,6 +36,7 @@ PROGRAM HydroDynDriver REAL(ReKi) :: Gravity CHARACTER(1024) :: HDInputFile CHARACTER(1024) :: OutRootName + LOGICAL :: Linearize INTEGER :: NSteps REAL(DbKi) :: TimeInterval INTEGER :: WAMITInputsMod @@ -111,7 +112,6 @@ PROGRAM HydroDynDriver real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds real(ReKi) :: UsrTime1 ! User CPU time for simulation initialization real(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) - real(ReKi) :: UsrTimeDiff ! Difference in CPU time from start to finish of program execution real(DbKi) :: TiLstPrn ! The simulation time of the last print real(DbKi) :: t_global ! Current simulation time (for global/FAST simulation) real(DbKi) :: SttsTime ! Amount of time between screen status messages (sec) @@ -157,11 +157,11 @@ PROGRAM HydroDynDriver call nwtc_init() ! Display the copyright notice - CALL DispCopyrightLicense( version ) + CALL DispCopyrightLicense( version%Name ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running - CALL WrScr( ' Running '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) + CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) IF ( command_argument_count() /= 1 ) THEN CALL print_help() @@ -184,6 +184,7 @@ PROGRAM HydroDynDriver InitInData%InputFile = drvrInitInp%HDInputFile InitInData%OutRootName = drvrInitInp%OutRootName InitInData%TMax = drvrInitInp%NSteps * drvrInitInp%TimeInterval + InitInData%Linearize = drvrInitInp%Linearize END IF ! Get the current time @@ -538,7 +539,7 @@ subroutine HD_DvrCleanup() end if ! Print *, time - call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time, UsrTimeDiff ) + call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time ) call NormStop() end subroutine HD_DvrCleanup @@ -743,7 +744,19 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) RETURN END IF + ! Linearize + CALL ReadVar ( UnIn, FileName, InitInp%Linearize, 'Linearize', & + 'Linearize parameter', ErrStat, ErrMsg, UnEchoLocal ) + + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Failed to read Linearize parameter.' + ErrStat = ErrID_Fatal + CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) + CLOSE( UnIn ) + RETURN + END IF + ! NSteps CALL ReadVar ( UnIn, FileName, InitInp%NSteps, 'NSteps', & diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 7c39aad002..025e7e3226 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -30,6 +30,7 @@ MODULE HydroDyn_Input USE WAMIT2_Output USE Waves2_Output USE Morison_Output + USE NWTC_RandomNumber IMPLICIT NONE PRIVATE :: CleanupEchoFile @@ -42,7 +43,7 @@ FUNCTION CheckMeshOutput( output, numMemberOut, MOutLst, numJointOut ) ! The routine !---------------------------------------------------------------------------------------------------- ! - CHARACTER(10), INTENT ( IN ) :: output + CHARACTER(ChanLen), INTENT ( IN ) :: output INTEGER, INTENT ( IN ) :: numMemberOut TYPE(Morison_MOutput), INTENT ( IN ) :: MOutLst(:) INTEGER, INTENT ( IN ) :: numJointOut @@ -52,7 +53,7 @@ FUNCTION CheckMeshOutput( output, numMemberOut, MOutLst, numJointOut ) LOGICAL :: CheckMeshOutput INTEGER :: ErrStat - CHARACTER(10) :: outputTmp + CHARACTER(ChanLen) :: outputTmp INTEGER :: indx1, indx2 CHARACTER(4) :: testStr outputTmp = TRIM(output) @@ -140,7 +141,7 @@ SUBROUTINE PrintBadChannelWarning(NUserOutputs, UserOutputs , foundMask, ErrStat ! The errstat is set to ErrID_Warning if any element in foundMask is .FALSE. !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(10), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. LOGICAL, INTENT( IN ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -218,8 +219,7 @@ SUBROUTINE HydroDynInput_GetInput( InitInp, ErrStat, ErrMsg ) ! INTEGER :: PropSetID ! Temporary storage of PropSetID read from HydroDyn input file ! INTEGER :: MemberID ! Temporary storage of MemberID read from HydroDyn input file INTEGER, ALLOCATABLE :: tmpArray(:) ! Temporary array storage of the joint output list - - + CHARACTER(1) :: Line1 ! The first character of an input line INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -520,22 +520,52 @@ SUBROUTINE HydroDynInput_GetInput( InitInp, ErrStat, ErrMsg ) InitInp%Waves%WaveDirRange = ABS( InitInp%Waves%WaveDirRange ) - ! WaveSeed(1), !WaveSeed(2) + ! WaveSeed(1) + CALL ReadVar( UnIn, FileName, InitInp%Waves%WaveSeed(1), 'WaveSeed(1)', "Random seed #1", ErrStat2, ErrMsg2, UnEchoLocal) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput') + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + InitInp%Waves%RNG%RandSeed(1) = InitInp%Waves%WaveSeed(1) - DO I = 1,2 + !WaveSeed(2) + CALL ReadVar( UnIn, FileName, Line, 'WaveSeed(2)', "Random seed #2", ErrStat2, ErrMsg2, UnEchoLocal) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput') + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF - WRITE(Line,'(I2)') I + READ (Line,*,IOSTAT=ErrStat2) Line1 ! check the first character to make sure we don't have T/F, which can be interpreted as 1/-1 or 0 in Fortran + CALL Conv2UC( Line1 ) + IF ( (Line1 == 'T') .OR. (Line1 == 'F') ) THEN + CALL SetErrStat( ErrID_Fatal, ' WaveSeed(2): Invalid RNG type.', ErrStat, ErrMsg, 'HydroDynInput_GetInput') + CALL Cleanup() + RETURN + ENDIF - CALL ReadVar ( UnIn, FileName, InitInp%Waves%WaveSeed(I), 'WaveSeed('//TRIM(Line)//')', & - 'Random seed #'//TRIM(Line), ErrStat2, ErrMsg2, UnEchoLocal ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF + READ (Line,*,IOSTAT=ErrStat2) InitInp%Waves%WaveSeed(2) + InitInp%Waves%RNG%RandSeed(2) = InitInp%Waves%WaveSeed(2) + + IF (ErrStat2 == 0) THEN ! the user entered a number + InitInp%Waves%RNG%RNG_type = "NORMAL" + InitInp%Waves%RNG%pRNG = pRNG_INTRINSIC + + ELSE - END DO !I + InitInp%Waves%RNG%RNG_type = ADJUSTL( Line ) + CALL Conv2UC( InitInp%Waves%RNG%RNG_type ) + IF ( InitInp%Waves%RNG%RNG_type == "RANLUX") THEN + InitInp%Waves%RNG%pRNG = pRNG_RANLUX + ELSE + CALL SetErrStat( ErrID_Fatal, ' WaveSeed(2): Invalid alternative random number generator.', ErrStat, ErrMsg, 'HydroDynInput_GetInput') + CALL Cleanup() + RETURN + ENDIF + + ENDIF ! WaveNDAmp - Flag for normally distributed amplitudes. @@ -873,6 +903,16 @@ SUBROUTINE HydroDynInput_GetInput( InitInp, ErrStat, ErrMsg ) RETURN END IF + ! ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (switch) + ! [STATE-SPACE REQUIRES *.ssexctn INPUT FILE] + + CALL ReadVar ( UnIn, FileName, InitInp%WAMIT%ExctnMod, 'ExctnMod', & + 'Wave Excitation model', ErrStat2, ErrMsg2, UnEchoLocal ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput' ) + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF ! RdtnMod - Radiation memory-effect model {1: convolution, 2: state-space} (switch) ! [STATE-SPACE REQUIRES *.ss INPUT FILE] @@ -2296,7 +2336,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) REAL(ReKi) :: z2 REAL(ReKi) :: MinMembrDpth REAL(ReKi) :: MaxMembrDpth -! CHARACTER(10), ALLOCATABLE :: tmpOutLst(:) ! +! CHARACTER(ChanLen), ALLOCATABLE :: tmpOutLst(:) ! CHARACTER(3) :: TmpExtension ! Temporary variable for holding the file extension for 10d, 11d, 12d, 10s, 11s, 12s WAMIT files LOGICAL :: TmpFileExist ! Temporary variable in checking the existance of an input file. LOGICAL :: JointUsed @@ -2306,7 +2346,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) INTEGER :: WaveModIn INTEGER(IntKi) :: ErrStat2, IOS - CHARACTER(1024) :: ErrMsg2 + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDynInput_ProcessInitData' ! Initialize ErrStat @@ -2398,7 +2438,23 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) END IF END IF - + ! Linearization Checks + ! LIN-TODO: + !errors if: + !if ( & + ! (WaveModIn /= 0) .or. & + ! (InitInp%Waves2%WvDiffQTFF /= .false.) .or. & + ! (InitInp%Waves2%WvSumQTFF /= .false.) .or. & + ! (InitInp%PotMod /= 0 .or. InitInp%PotMod /=1) .or. & + ! (InitInp%WAMIT%ExctnMod /=0 .or. InitInp%WAMIT%ExctnMod /=2) .or. & + ! (InitInp%WAMIT%RdtnMod /=0 .or. InitInp%WAMIT%RdtnMod /=2) .or. & + ! (InitInp%WAMIT2%MnDrift /=0) .or. & + ! (InitInp%WAMIT2%NewmanApp /= 0) .or. & + ! (InitInp%WAMIT2%SumQTF /= 0 ) ) then + ! + !end if + + ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. ! TODO: We are only implementing WaveStMod = 0 (No stretching) at this point in time. 1 Mar 2013 GJH @@ -2449,7 +2505,11 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. IF ( .NOT. EqualRealNos(InitInp%Waves%WaveTMax, 0.0_DbKi) ) THEN CALL WrScr( ' Setting WaveTMax to 0.0 since WaveMod = 0' ) - InitInp%Waves%WaveTMax = 0.0 + InitInp%Waves%WaveTMax = 0.0 + END IF + IF ( .NOT. EqualRealNos(InitInp%Waves%WaveDir, 0.0_SiKi) ) THEN + CALL WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) + InitInp%Waves%WaveDir = 0.0 END IF ELSEIF ( InitInp%Waves%WaveMod == 5 ) THEN ! User wave elevation file reading in IF (InitInp%TMax > InitInp%Waves%WaveTMax ) THEN @@ -3011,6 +3071,11 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) RETURN END IF + if ( (.not. ( EqualRealNos(InitInp%DT, InitInp%WAMIT%Conv_Rdtn%RdtnDT) ) ) .and. ( (InitInp%WAMIT%ExctnMod > 1) .or. (InitInp%WAMIT%RdtnMod > 0) ) ) then + call SetErrStat( ErrID_Fatal,'RdtnDT must be equal to the glue-code DT if PotMod = 1 and using RdtnMod > 0 or ExctnMod > 1.',ErrStat,ErrMsg,RoutineName) + return + end if + ELSE InitInp%WAMIT%Conv_Rdtn%RdtnDT = 0.0 @@ -3253,8 +3318,100 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) END IF END IF + !.................. + ! check for ExctnMod = 2 requirements + !.................. + if ( (InitInp%WAMIT%ExctnMod == 2) ) then - + if ( InitInp%Waves%WaveMod == 6 ) then + call SetErrStat( ErrID_Fatal, 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%Waves%WaveDirMod /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%Waves2%WvDiffQTFF ) then + call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%Waves2%WvSumQTFF ) then + call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%PotMod /= 1 ) then + call SetErrStat( ErrID_Fatal, 'Potential-flow model via WAMIT must be used with state-space wave excitations. Set PotMod= 1.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%MnDrift /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Mean-drift 2nd-order forces cannot be used with state-space wave excitations. Set MnDrift=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%NewmanApp /= 0 ) then + call SetErrStat( ErrID_Fatal, "Mean- and slow-drift 2nd-order forces computed with Newman's approximation cannot be used with state-space wave excitations. Set NewmanApp=0.", ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%DiffQTF /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Full difference-frequency 2nd-order forces computed with full QTF cannot be used with state-space wave excitations. Set DiffQTF=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%SumQTF /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Full summation-frequency 2nd-order forces computed with full QTF cannot be used with State-space wave excitations. Set SumQTF=0.', ErrStat, ErrMsg, RoutineName ) + end if + + end if + + !.................. + ! check for linearization + !.................. + if (InitInp%Linearize) then + + if ( InitInp%Waves%WaveMod /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Still water conditions must be used for linearization. Set WaveMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%Waves%WaveDirMod /= 0 ) then + call SetErrStat( ErrID_Fatal, 'No directional spreading must be used for linearization. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%Waves2%WvDiffQTFF ) then + call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics for linearization. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%Waves2%WvSumQTFF ) then + call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics for linearization. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%PotMod > 1 ) then + call SetErrStat( ErrID_Fatal, 'Potential-flow model cannot be set to FIT for linearization. Set PotMod= 0 or 1.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( (InitInp%WAMIT%ExctnMod == 1) ) then + call SetErrStat( ErrID_Fatal, 'Cannot set wave excitation model to DFT for linearization. Set ExctnMod=0 or 2.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT%RdtnMod == 1 ) then + call SetErrStat( ErrID_Fatal, 'Cannot set wave radiation model to convolution for linearization. Set RdtnMod=0 or 2.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%MnDrift /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Mean-drift 2nd-order forces cannot be used for linearization. Set MnDrift=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%NewmanApp /= 0 ) then + call SetErrStat( ErrID_Fatal, "Mean- and slow-drift 2nd-order forces computed with Newman's approximation cannot be used for linearization. Set NewmanApp=0.", ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%DiffQTF /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Full difference-frequency 2nd-order forces computed with full QTF cannot be used for linearization. Set DiffQTF=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InitInp%WAMIT2%SumQTF /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Full summation-frequency 2nd-order forces computed with full QTF cannot be used for linearization. Set SumQTF=0.', ErrStat, ErrMsg, RoutineName ) + end if + + end if + diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 5e25c03d8e..4f9f02318f 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -294,7 +294,7 @@ SUBROUTINE HDOut_WriteWvKinFiles( Rootname, HD_Prog, NStepWave, NNodes, NWaveEle CHARACTER(5) :: extension(7) INTEGER :: i, j, iFile CHARACTER(64) :: Frmt, Sfrmt - CHARACTER(10) :: Delim + CHARACTER(ChanLen) :: Delim ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -717,10 +717,7 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, InitInp, y, p, m, InitOut, ErrStat, E IF (ErrStat >= AbortErrLev ) RETURN END IF - IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing - ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! - DEALLOCATE ( InitOut%WriteOutputHdr ) - END IF + RETURN @@ -780,7 +777,12 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'These predictions were generated by '//TRIM(HydroDyn_ProgDesc%Name)//& ' on '//CurDate()//' at '//CurTime()//'.' - + + ! Write three empty lines + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) + ! Write the names of the output parameters: Frmt = '(A8)' WRITE(p%UnOutFile,Frmt,ADVANCE='no') TRIM( 'Time' ) @@ -813,7 +815,7 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) ! write the line return - + ! Write the units of the output parameters: @@ -865,8 +867,8 @@ FUNCTION HDOut_GetChannels ( NUserOutputs, UserOutputs, OutList, foundMask, !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(10), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(10), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. + CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -879,7 +881,7 @@ FUNCTION HDOut_GetChannels ( NUserOutputs, UserOutputs, OutList, foundMask, INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. LOGICAL :: CheckOutListAgain LOGICAL :: newFoundMask (NUserOutputs) ! A mask indicating whether a user requested channel belongs to a module's output channels. @@ -972,7 +974,7 @@ SUBROUTINE HDOut_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) TYPE(HydroDyn_OutputType), INTENT( INOUT ) :: y ! This module's internal data TYPE(HydroDyn_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the HD module ! INTEGER, INTENT(IN ) :: NumMemberNodes(*) ! the number of nodes on each of the first 9 members - CHARACTER(10), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -982,7 +984,7 @@ SUBROUTINE HDOut_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) ! INTEGER :: J ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. LOGICAL :: InvalidOutput(MaxHDOutputs) ! This array determines if the output channel is valid for this configuration LOGICAL :: CheckOutListAgain @@ -1097,7 +1099,7 @@ SUBROUTINE HDOut_CloseOutput ( p, ErrStat, ErrMsg ) ! Write the summary file header IF ( p%UnOutFile > -1 ) THEN - WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'This output file was closed on '//CurDate()//' at '//CurTime()//'.' + ! WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'This output file was closed on '//CurDate()//' at '//CurTime()//'.' !------------------------------------------------------------------------------------------------- ! Close our output file diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 60d0967c55..1b6b52b75c 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -36,6 +36,7 @@ MODULE HydroDyn_Types USE Waves2_Types USE Conv_Radiation_Types USE SS_Radiation_Types +USE SS_Excitation_Types USE WAMIT_Types USE WAMIT2_Types USE Morison_Types @@ -47,6 +48,7 @@ MODULE HydroDyn_Types CHARACTER(1024) :: InputFile !< Supplied by Driver: full path and filename for the HydroDyn module [-] LOGICAL :: UseInputFile !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] REAL(DbKi) :: DT !< Supplied by Driver: Simulation time step [(sec)] REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] @@ -80,11 +82,11 @@ MODULE HydroDyn_Types LOGICAL :: Echo !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] INTEGER(IntKi) :: NUserOutputs !< Number of Hydrodyn-level requested output channels [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: UserOutputs !< This should really be dimensioned with MaxOutPts [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: UserOutputs !< This should really be dimensioned with MaxOutPts [-] INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] LOGICAL :: OutAll !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] INTEGER(IntKi) :: NumOuts !< The number of outputs for this module as requested in the input file [-] - CHARACTER(10) , DIMENSION(1:54) :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] + CHARACTER(ChanLen) , DIMENSION(1:54) :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] LOGICAL :: HDSum !< Generate a HydroDyn summary file [T/F] [-] INTEGER(IntKi) :: UnSum !< File unit for the HydroDyn summary file [-1 = no summary file] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] @@ -97,13 +99,18 @@ MODULE HydroDyn_Types TYPE(WAMIT2_InitOutputType) :: WAMIT2 !< Initialization output from the WAMIT2 module [-] TYPE(Waves2_InitOutputType) :: Waves2 !< Initialization output from the Waves2 module [-] TYPE(Morison_InitOutputType) :: Morison !< Initialization output from the Morison module [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY. [(m)] TYPE(ProgDesc) :: Ver !< Version of HydroDyn [-] REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] REAL(ReKi) :: WtrDpth !< Water depth [(m)] REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [(m)] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] END TYPE HydroDyn_InitOutputType ! ======================= ! ========= HD_ModuleMapType ======= @@ -179,6 +186,7 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: NWaveElev !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Total wave elevation [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [-] + REAL(ReKi) :: WtrDpth !< Water depth [(m)] REAL(ReKi) , DIMENSION(1:6) :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(1:6,1:6) :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(1:6,1:6) :: AddBLin !< Additional linear damping matrix [-] @@ -190,9 +198,13 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] - CHARACTER(10) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] + CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile !< File unit for the HydroDyn outputs [-] INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] + INTEGER(IntKi) , 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 [-] END TYPE HydroDyn_ParameterType ! ======================= ! ========= HydroDyn_InputType ======= @@ -232,6 +244,7 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%InputFile = SrcInitInputData%InputFile DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Linearize = SrcInitInputData%Linearize DstInitInputData%DT = SrcInitInputData%DT DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%TMax = SrcInitInputData%TMax @@ -373,6 +386,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile Int_BufSz = Int_BufSz + 1 ! UseInputFile Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName + Int_BufSz = Int_BufSz + 1 ! Linearize Db_BufSz = Db_BufSz + 1 ! DT Re_BufSz = Re_BufSz + 1 ! Gravity Db_BufSz = Db_BufSz + 1 ! TMax @@ -547,24 +561,26 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseInputFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasIce , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasIce, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -578,57 +594,75 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%PtfmSgFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSgFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmSwFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSwFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmHvFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmHvFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmRFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmRFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmPFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmPFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmYFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmYFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddF0))-1 ) = PACK(InData%AddF0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddF0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddCLin))-1 ) = PACK(InData%AddCLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddCLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBLin))-1 ) = PACK(InData%AddBLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBQuad))-1 ) = PACK(InData%AddBQuad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBQuad) + ReKiBuf(Re_Xferred) = InData%PtfmLocationX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmLocationY + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%PtfmSgFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSgFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmSwFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSwFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmHvFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmHvFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmRFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmRFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmPFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmPFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmYFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmYFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) + ReKiBuf(Re_Xferred) = InData%AddF0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) + DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) + ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) + DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) + ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) + DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) + ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, OnlySize ) ! Waves CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -713,10 +747,10 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%PotFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%PotFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -801,12 +835,12 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NUserOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PotMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NUserOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%UserOutputs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -817,37 +851,37 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserOutputs,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) + DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) DO I = 1, LEN(InData%UserOutputs) IntKiBuf(Int_Xferred) = ICHAR(InData%UserOutputs(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HDSum , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%HDSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -863,12 +897,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -884,24 +912,26 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseInputFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HasIce = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HasIce = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasIce) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -918,106 +948,89 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%PtfmLocationX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%PtfmSgFChr) - OutData%PtfmSgFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmSgF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmSwFChr) - OutData%PtfmSwFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmSwF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmHvFChr) - OutData%PtfmHvFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmHvF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmRFChr) - OutData%PtfmRFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmRF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmPFChr) - OutData%PtfmPFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmPF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmYFChr) - OutData%PtfmYFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmYF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%PtfmLocationX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmLocationY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%PtfmSgFChr) + OutData%PtfmSgFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmSgF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmSwFChr) + OutData%PtfmSwFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmSwF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmHvFChr) + OutData%PtfmHvFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmHvF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmRFChr) + OutData%PtfmRFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmRF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmPFChr) + OutData%PtfmPFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmPF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmYFChr) + OutData%PtfmYFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmYF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%AddF0,1) i1_u = UBOUND(OutData%AddF0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AddF0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddF0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddF0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) + OutData%AddF0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AddCLin,1) i1_u = UBOUND(OutData%AddCLin,1) i2_l = LBOUND(OutData%AddCLin,2) i2_u = UBOUND(OutData%AddCLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddCLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddCLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddCLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) + DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) + OutData%AddCLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBLin,1) i1_u = UBOUND(OutData%AddBLin,1) i2_l = LBOUND(OutData%AddBLin,2) i2_u = UBOUND(OutData%AddBLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) + DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) + OutData%AddBLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBQuad,1) i1_u = UBOUND(OutData%AddBQuad,1) i2_l = LBOUND(OutData%AddBQuad,2) i2_u = UBOUND(OutData%AddBQuad,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBQuad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBQuad))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBQuad) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) + DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) + OutData%AddBQuad(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1138,10 +1151,10 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%PotFile) - OutData%PotFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%PotFile) + OutData%PotFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1262,12 +1275,12 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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 ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PotMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NUserOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%PotMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NUserOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserOutputs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1281,53 +1294,39 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) + DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) DO I = 1, LEN(OutData%UserOutputs) OutData%UserOutputs(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%HDSum = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I + END DO + OutData%HDSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%HDSum) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE HydroDyn_UnPackInitInput SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1402,6 +1401,66 @@ SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCo DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL +IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN + ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN + ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN + ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) + i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN + ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN + i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) + i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN + ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u +ENDIF END SUBROUTINE HydroDyn_CopyInitOutput SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) @@ -1427,6 +1486,21 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) +IF (ALLOCATED(InitOutputData%LinNames_y)) THEN + DEALLOCATE(InitOutputData%LinNames_y) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_x)) THEN + DEALLOCATE(InitOutputData%LinNames_x) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_u)) THEN + DEALLOCATE(InitOutputData%LinNames_u) +ENDIF +IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN + DEALLOCATE(InitOutputData%DerivOrder_x) +ENDIF +IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN + DEALLOCATE(InitOutputData%IsLoad_u) +ENDIF END SUBROUTINE HydroDyn_DestroyInitOutput SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1568,6 +1642,31 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = Re_BufSz + 1 ! WtrDens Re_BufSz = Re_BufSz + 1 ! WtrDpth Re_BufSz = Re_BufSz + 1 ! MSL2SWL + Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no + IF ( ALLOCATED(InData%LinNames_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no + IF ( ALLOCATED(InData%LinNames_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no + IF ( ALLOCATED(InData%LinNames_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u + END IF + Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no + IF ( ALLOCATED(InData%DerivOrder_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1717,12 +1816,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1734,12 +1833,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1754,8 +1853,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries))-1 ) = PACK(InData%WaveElevSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries) + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1785,12 +1888,93 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO I = 1, LEN(InData%LinNames_y) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO I = 1, LEN(InData%LinNames_x) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO I = 1, LEN(InData%LinNames_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF END SUBROUTINE HydroDyn_PackInitOutput SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1806,12 +1990,6 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2000,19 +2178,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2027,19 +2198,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 @@ -2057,15 +2221,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries)>0) OutData%WaveElevSeries = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2107,12 +2268,108 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) + ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO I = 1, LEN(OutData%LinNames_y) + OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) + ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO I = 1, LEN(OutData%LinNames_x) + OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) + ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO I = 1, LEN(OutData%LinNames_u) + OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) + ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF END SUBROUTINE HydroDyn_UnPackInitOutput SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2367,12 +2624,6 @@ SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' @@ -2809,12 +3060,6 @@ SUBROUTINE HydroDyn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackContState' @@ -3291,12 +3536,6 @@ SUBROUTINE HydroDyn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackDiscState' @@ -3773,12 +4012,6 @@ SUBROUTINE HydroDyn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackConstrState' @@ -4255,12 +4488,6 @@ SUBROUTINE HydroDyn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackOtherState' @@ -4931,18 +5158,24 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAdd))-1 ) = PACK(InData%F_PtfmAdd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAdd) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Hydro))-1 ) = PACK(InData%F_Hydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Hydro) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves))-1 ) = PACK(InData%F_Waves,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves) + IntKiBuf(Int_Xferred) = InData%Decimate + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Hydro,1), UBOUND(InData%F_Hydro,1) + ReKiBuf(Re_Xferred) = InData%F_Hydro(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Waves,1), UBOUND(InData%F_Waves,1) + ReKiBuf(Re_Xferred) = InData%F_Waves(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5154,12 +5387,6 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5374,45 +5601,30 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Decimate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Decimate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_PtfmAdd,1) i1_u = UBOUND(OutData%F_PtfmAdd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAdd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAdd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAdd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) + OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Hydro,1) i1_u = UBOUND(OutData%F_Hydro,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Hydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Hydro))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Hydro) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Hydro,1), UBOUND(OutData%F_Hydro,1) + OutData%F_Hydro(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Waves,1) i1_u = UBOUND(OutData%F_Waves,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves,1), UBOUND(OutData%F_Waves,1) + OutData%F_Waves(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5766,6 +5978,7 @@ SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Er END IF DstParamData%WaveElev1 = SrcParamData%WaveElev1 ENDIF + DstParamData%WtrDpth = SrcParamData%WtrDpth DstParamData%AddF0 = SrcParamData%AddF0 DstParamData%AddCLin = SrcParamData%AddCLin DstParamData%AddBLin = SrcParamData%AddBLin @@ -5795,6 +6008,45 @@ SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%Delim = SrcParamData%Delim DstParamData%UnOutFile = SrcParamData%UnOutFile DstParamData%OutDec = SrcParamData%OutDec +IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcParamData%Jac_u_indx,1) + i1_u = UBOUND(SrcParamData%Jac_u_indx,1) + i2_l = LBOUND(SrcParamData%Jac_u_indx,2) + i2_u = UBOUND(SrcParamData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN + ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx +ENDIF +IF (ALLOCATED(SrcParamData%du)) THEN + i1_l = LBOUND(SrcParamData%du,1) + i1_u = UBOUND(SrcParamData%du,1) + IF (.NOT. ALLOCATED(DstParamData%du)) THEN + ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%du = SrcParamData%du +ENDIF +IF (ALLOCATED(SrcParamData%dx)) THEN + i1_l = LBOUND(SrcParamData%dx,1) + i1_u = UBOUND(SrcParamData%dx,1) + IF (.NOT. ALLOCATED(DstParamData%dx)) THEN + ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%dx = SrcParamData%dx +ENDIF + DstParamData%Jac_ny = SrcParamData%Jac_ny END SUBROUTINE HydroDyn_CopyParam SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -5824,6 +6076,15 @@ SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%Jac_u_indx)) THEN + DEALLOCATE(ParamData%Jac_u_indx) +ENDIF +IF (ALLOCATED(ParamData%du)) THEN + DEALLOCATE(ParamData%du) +ENDIF +IF (ALLOCATED(ParamData%dx)) THEN + DEALLOCATE(ParamData%dx) ENDIF END SUBROUTINE HydroDyn_DestroyParam @@ -5949,6 +6210,7 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 2*2 ! WaveElev1 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 END IF + Re_BufSz = Re_BufSz + 1 ! WtrDpth Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin @@ -5985,6 +6247,22 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim Int_BufSz = Int_BufSz + 1 ! UnOutFile Int_BufSz = Int_BufSz + 1 ! OutDec + Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no + IF ( ALLOCATED(InData%Jac_u_indx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx + END IF + Int_BufSz = Int_BufSz + 1 ! du allocated yes/no + IF ( ALLOCATED(InData%du) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%du) ! du + END IF + Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no + IF ( ALLOCATED(InData%dx) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx + END IF + Int_BufSz = Int_BufSz + 1 ! Jac_ny IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -6124,8 +6402,8 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PotMod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PotMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6136,13 +6414,15 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6156,8 +6436,12 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6172,19 +6456,39 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev1))-1 ) = PACK(InData%WaveElev1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev1) + DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) + DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) + ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddF0))-1 ) = PACK(InData%AddF0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddF0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddCLin))-1 ) = PACK(InData%AddCLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddCLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBLin))-1 ) = PACK(InData%AddBLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBQuad))-1 ) = PACK(InData%AddBQuad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBQuad) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) + ReKiBuf(Re_Xferred) = InData%AddF0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) + DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) + ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) + DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) + ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) + DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) + ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6226,28 +6530,80 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTotalOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutDec - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTotalOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%du) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackParam SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6263,12 +6619,6 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6444,8 +6794,8 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%PotMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%PotMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6459,20 +6809,15 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6489,15 +6834,12 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated Int_Xferred = Int_Xferred + 1 @@ -6515,68 +6857,53 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev1)>0) OutData%WaveElev1 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev1))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) + DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) + OutData%WaveElev1(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%AddF0,1) i1_u = UBOUND(OutData%AddF0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AddF0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddF0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddF0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) + OutData%AddF0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AddCLin,1) i1_u = UBOUND(OutData%AddCLin,1) i2_l = LBOUND(OutData%AddCLin,2) i2_u = UBOUND(OutData%AddCLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddCLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddCLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddCLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) + DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) + OutData%AddCLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBLin,1) i1_u = UBOUND(OutData%AddBLin,1) i2_l = LBOUND(OutData%AddBLin,2) i2_u = UBOUND(OutData%AddBLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) + DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) + OutData%AddBLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBQuad,1) i1_u = UBOUND(OutData%AddBQuad,1) i2_l = LBOUND(OutData%AddBQuad,2) i2_u = UBOUND(OutData%AddBQuad,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBQuad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBQuad))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBQuad) - DEALLOCATE(mask2) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) + DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) + OutData%AddBQuad(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6633,28 +6960,89 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTotalOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumTotalOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) + ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) + ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackParam SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -6860,12 +7248,6 @@ SUBROUTINE HydroDyn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInput' @@ -7376,8 +7758,10 @@ SUBROUTINE HydroDyn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_PackOutput @@ -7394,12 +7778,6 @@ SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7667,15 +8045,10 @@ SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_UnPackOutput @@ -7754,8 +8127,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -7770,6 +8143,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) @@ -7803,8 +8178,9 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp2' @@ -7826,6 +8202,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) @@ -7907,12 +8285,12 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7925,6 +8303,8 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT, y2%WAMIT, tin, y_out%WAMIT, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2, y2%WAMIT2, tin, y_out%WAMIT2, tin_out, ErrStat2, ErrMsg2 ) @@ -7938,12 +8318,10 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E CALL MeshExtrapInterp1(y1%AllHdroOrigin, y2%AllHdroOrigin, tin, y_out%AllHdroOrigin, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE HydroDyn_Output_ExtrapInterp1 @@ -7974,13 +8352,14 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7999,6 +8378,8 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT, y2%WAMIT, y3%WAMIT, tin, y_out%WAMIT, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2, y2%WAMIT2, y3%WAMIT2, tin, y_out%WAMIT2, tin_out, ErrStat2, ErrMsg2 ) @@ -8012,13 +8393,11 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta CALL MeshExtrapInterp2(y1%AllHdroOrigin, y2%AllHdroOrigin, y3%AllHdroOrigin, tin, y_out%AllHdroOrigin, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE HydroDyn_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 5e051600a1..c0fdc4b52e 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1020,7 +1020,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, WtrDpth, numNodes, nodes, numElemen REAL(ReKi) :: l ! length of an element LOGICAL :: filledFlag ! flag indicating if element is filled/flooded CHARACTER(2) :: strFmt - CHARACTER(10) :: strNodeType ! string indicating type of node: End, Interior, Super + CHARACTER(ChanLen) :: strNodeType ! string indicating type of node: End, Interior, Super REAL(ReKi) :: ident(3,3) ! identity matrix REAL(ReKi) :: ExtBuoyancy(6) ! sum of all external buoyancy forces lumped at (0,0,0) REAL(ReKi) :: IntBuoyancy(6) ! sum of all internal buoyancy forces lumped at (0,0,0) @@ -1041,7 +1041,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, WtrDpth, numNodes, nodes, numElemen REAL(ReKi) :: s ! The linear interpolation factor for the requested location REAL(ReKi) :: outloc(3) ! Position of the requested member output INTEGER :: mbrIndx, nodeIndx - CHARACTER(10) :: tmpName + CHARACTER(ChanLen) :: tmpName REAL(ReKi) :: totalFillMass, mass_fill, fillVol REAL(ReKi) :: totalMGMass, mass_MG TYPE(Morison_NodeType) :: node1, node2 diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 28caed10a1..5326fb452c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -223,7 +223,7 @@ typedef ^ ^ INTEGER typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - typedef ^ ^ INTEGER NJOutputs - - - "" - typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - -typedef ^ ^ CHARACTER(10) OutList {4032} - - "This list size needs to be the maximum # of possible outputs because of the use of ReadAry()" - +typedef ^ ^ CHARACTER(ChanLen) OutList {4032} - - "This list size needs to be the maximum # of possible outputs because of the use of ReadAry()" - typedef ^ ^ LOGICAL ValidOutList {:} - - "" - typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER OutSwtch - - - "" - @@ -244,8 +244,8 @@ typedef ^ ^ INTEGER typedef ^ InitOutputType MeshType DistribMesh - - - "" - typedef ^ ^ MeshType LumpedMesh - - - "" - typedef ^ ^ SiKi Morison_Rad {:} - - "radius of node (for FAST visualization)" (m) -typedef ^ ^ CHARACTER(10) WriteOutputHdr {:} - - "" - -typedef ^ ^ CHARACTER(10) WriteOutputUnt {:} - - "" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - # # # ..... States .................................................................................................................... @@ -339,7 +339,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER UnOutFile - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/Morison_Output.f90 b/modules/hydrodyn/src/Morison_Output.f90 index 294c3478c7..f859a3a556 100644 --- a/modules/hydrodyn/src/Morison_Output.f90 +++ b/modules/hydrodyn/src/Morison_Output.f90 @@ -7327,7 +7327,7 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) IF ( InitInp%OutAll ) THEN ! p%NumOutAll = InitInp%NMember*2*22 + InitInp%NJoints*19 - p%NumOutAll = 0 + p%NumOutAll = 0 ELSE p%NumOutAll = 0 END IF @@ -7430,8 +7430,8 @@ FUNCTION GetMorisonChannels ( NUserOutputs, UserOutputs, OutList, foundMask !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(10), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(10), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. + CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -7444,7 +7444,7 @@ FUNCTION GetMorisonChannels ( NUserOutputs, UserOutputs, OutList, foundMask INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. ! LOGICAL :: InvalidOutput(MaxMrsnOutputs) ! This array determines if the output channel is valid for this configuration LOGICAL :: CheckOutListAgain @@ -7534,7 +7534,7 @@ SUBROUTINE MrsnOut_ChkOutLst( OutList, ValidOutList, y, p, ErrStat, ErrMsg ) ! Passed variables - CHARACTER(10), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. LOGICAL, INTENT( IN ) :: ValidOutList (:) ! An array holding the a flag for whether the elements are valid requested output channels. TYPE(Morison_OutputType), INTENT( INOUT ) :: y ! Morison module output data TYPE(Morison_ParameterType), INTENT( INOUT ) :: p ! Morison module parameter data @@ -7548,7 +7548,7 @@ SUBROUTINE MrsnOut_ChkOutLst( OutList, ValidOutList, y, p, ErrStat, ErrMsg ) ! INTEGER :: J ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 8953764c66..5a0989fc09 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -283,7 +283,7 @@ MODULE Morison_Types TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] INTEGER(IntKi) :: NJOutputs !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] - CHARACTER(10) , DIMENSION(1:4032) :: OutList !< This list size needs to be the maximum of possible outputs because of the use of ReadAry() [-] + CHARACTER(ChanLen) , DIMENSION(1:4032) :: OutList !< This list size needs to be the maximum of possible outputs because of the use of ReadAry() [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: ValidOutList !< [-] INTEGER(IntKi) :: NumOuts !< [-] INTEGER(IntKi) :: OutSwtch !< [-] @@ -304,8 +304,8 @@ MODULE Morison_Types TYPE(MeshType) :: DistribMesh !< [-] TYPE(MeshType) :: LumpedMesh !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Morison_Rad !< radius of node (for FAST visualization) [(m)] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] END TYPE Morison_InitOutputType ! ======================= ! ========= Morison_ContinuousStateType ======= @@ -396,7 +396,7 @@ MODULE Morison_Types INTEGER(IntKi) :: UnOutFile !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= @@ -519,20 +519,24 @@ SUBROUTINE Morison_PackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JointPos))-1 ) = PACK(InData%JointPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JointPos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnectionList))-1 ) = PACK(InData%ConnectionList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnectionList) + IntKiBuf(Int_Xferred) = InData%JointID + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%JointPos,1), UBOUND(InData%JointPos,1) + ReKiBuf(Re_Xferred) = InData%JointPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%JointAxID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointAxIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointOvrlp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnections + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) + IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_PackJointType SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -548,12 +552,6 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -570,38 +568,28 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%JointID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%JointID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%JointPos,1) i1_u = UBOUND(OutData%JointPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JointPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JointPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JointPos) - DEALLOCATE(mask1) - OutData%JointAxID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointOvrlp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%JointPos,1), UBOUND(OutData%JointPos,1) + OutData%JointPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%JointAxID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointOvrlp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnections = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ConnectionList,1) i1_u = UBOUND(OutData%ConnectionList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ConnectionList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnectionList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnectionList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) + OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_UnPackJointType SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -699,12 +687,12 @@ SUBROUTINE Morison_PackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PropSetID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropThck - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropSetID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropThck + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackMemberPropType SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -720,12 +708,6 @@ SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberPropType' @@ -739,12 +721,12 @@ SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%PropSetID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PropThck = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%PropSetID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PropThck = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackMemberPropType SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -865,8 +847,8 @@ SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FillNumM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FillNumM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FillMList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -877,17 +859,19 @@ SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FillMList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FillMList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FillMList))-1 ) = PACK(InData%FillMList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FillMList) + DO i1 = LBOUND(InData%FillMList,1), UBOUND(InData%FillMList,1) + IntKiBuf(Int_Xferred) = InData%FillMList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FillDensChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%FillDensChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%FillDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackFilledGroupType SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -903,12 +887,6 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -923,8 +901,8 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FillNumM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FillNumM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FillMList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -938,24 +916,19 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FillMList)>0) OutData%FillMList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FillMList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FillMList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FillMList,1), UBOUND(OutData%FillMList,1) + OutData%FillMList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FillDensChr) - OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FillDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%FillDensChr) + OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%FillDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackFilledGroupType SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) @@ -1069,28 +1042,28 @@ SUBROUTINE Morison_PackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCpMG - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCpMG + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackCoefDpths SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1106,12 +1079,6 @@ SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefDpths' @@ -1125,28 +1092,28 @@ SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackCoefDpths SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1246,14 +1213,14 @@ SUBROUTINE Morison_PackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AxCoefID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AxCoefID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackAxialCoefType SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1269,12 +1236,6 @@ SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackAxialCoefType' @@ -1288,14 +1249,14 @@ SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AxCoefID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AxCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AxCoefID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AxCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackAxialCoefType SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1423,40 +1384,46 @@ SUBROUTINE Morison_PackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID2Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSplits - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Splits))-1 ) = PACK(InData%Splits,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Splits) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID2Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID2Indx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MDivSize + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MCoefMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSplits + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Splits,1), UBOUND(InData%Splits,1) + ReKiBuf(Re_Xferred) = InData%Splits(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_PackMemberInputType SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1472,12 +1439,6 @@ SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1493,60 +1454,52 @@ SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MDivSize = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumSplits = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MDivSize = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MCoefMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 + OutData%NumSplits = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Splits,1) i1_u = UBOUND(OutData%Splits,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Splits = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Splits))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Splits) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Splits,1), UBOUND(OutData%Splits,1) + OutData%Splits(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_UnPackMemberInputType SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1706,72 +1659,80 @@ SUBROUTINE Morison_PackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NodeType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JointPos))-1 ) = PACK(InData%JointPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JointPos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnectionList))-1 ) = PACK(InData%ConnectionList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnectionList) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnectPreSplit - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dRdz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGdensity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FillFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDensity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InpMbrIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) + IntKiBuf(Int_Xferred) = InData%NodeType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointIndx + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%JointPos,1), UBOUND(InData%JointPos,1) + ReKiBuf(Re_Xferred) = InData%JointPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%JointOvrlp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointAxIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnections + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) + IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NConnectPreSplit + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dRdz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGdensity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FillFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillDensity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InpMbrIndx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_PackNodeType SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1787,12 +1748,6 @@ SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1808,101 +1763,88 @@ SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NodeType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NodeType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%JointPos,1) i1_u = UBOUND(OutData%JointPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JointPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JointPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JointPos) - DEALLOCATE(mask1) - OutData%JointOvrlp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%JointPos,1), UBOUND(OutData%JointPos,1) + OutData%JointPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%JointOvrlp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnections = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ConnectionList,1) i1_u = UBOUND(OutData%ConnectionList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ConnectionList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnectionList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnectionList) - DEALLOCATE(mask1) - OutData%NConnectPreSplit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dRdz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGdensity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FillDensity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InpMbrDist = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) + OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NConnectPreSplit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dRdz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGdensity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%FillFlag) + Int_Xferred = Int_Xferred + 1 + OutData%FillDensity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InpMbrDist = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_UnPackNodeType SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2082,92 +2024,102 @@ SUBROUTINE Morison_PackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Node1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Node2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrLen - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InpMbrIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSplits - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Splits))-1 ) = PACK(InData%Splits,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Splits) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGvolume - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Bouy))-1 ) = PACK(InData%F_Bouy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Bouy) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_DP))-1 ) = PACK(InData%F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_DP) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Node1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Node2Indx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrLen + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InpMbrIndx + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%NumSplits + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Splits,1), UBOUND(InData%Splits,1) + ReKiBuf(Re_Xferred) = InData%Splits(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%MGvolume + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MDivSize + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MCoefMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillDens + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%F_Bouy,1), UBOUND(InData%F_Bouy,1) + ReKiBuf(Re_Xferred) = InData%F_Bouy(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_DP,1), UBOUND(InData%F_DP,1) + ReKiBuf(Re_Xferred) = InData%F_DP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackMemberType SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2183,12 +2135,6 @@ SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2204,130 +2150,112 @@ SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Node1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Node2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%R1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrDist1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrDist2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrLen = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Node1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Node2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%R1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrDist1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrDist2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrLen = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) - OutData%NumSplits = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%NumSplits = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Splits,1) i1_u = UBOUND(OutData%Splits,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Splits = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Splits))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Splits) - DEALLOCATE(mask1) - OutData%MGvolume = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MDivSize = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%Splits,1), UBOUND(OutData%Splits,1) + OutData%Splits(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%MGvolume = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MDivSize = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MCoefMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%F_Bouy,1) i1_u = UBOUND(OutData%F_Bouy,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Bouy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Bouy))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Bouy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Bouy,1), UBOUND(OutData%F_Bouy,1) + OutData%F_Bouy(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_DP,1) i1_u = UBOUND(OutData%F_DP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_DP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_DP) - DEALLOCATE(mask1) - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_DP,1), UBOUND(OutData%F_DP,1) + OutData%F_DP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackMemberType SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) @@ -2461,48 +2389,48 @@ SUBROUTINE Morison_PackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCpMG2 - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCd1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCd2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCdMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCdMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCpMG2 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackCoefMembers SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2518,12 +2446,6 @@ SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefMembers' @@ -2537,48 +2459,48 @@ SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MemberCd1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCd2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MemberCd1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCd2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCdMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCdMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackCoefMembers SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2676,12 +2598,12 @@ SUBROUTINE Morison_PackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGThck - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGThck + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackMGDepthsType SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2697,12 +2619,6 @@ SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMGDepthsType' @@ -2716,12 +2632,12 @@ SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MGDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGThck = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%MGDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGThck = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackMGDepthsType SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2900,10 +2816,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutLoc - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutLoc + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NodeLocs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2914,11 +2830,13 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeLocs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeLocs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NodeLocs))-1 ) = PACK(InData%NodeLocs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NodeLocs) + DO i1 = LBOUND(InData%NodeLocs,1), UBOUND(InData%NodeLocs,1) + ReKiBuf(Re_Xferred) = InData%NodeLocs(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberIDIndx - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberIDIndx + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Marker1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2929,8 +2847,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Marker1,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Marker1)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Marker1))-1 ) = PACK(InData%Marker1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Marker1) + DO i1 = LBOUND(InData%Marker1,1), UBOUND(InData%Marker1,1) + IntKiBuf(Int_Xferred) = InData%Marker1(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Marker2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2942,8 +2862,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Marker2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Marker2)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Marker2))-1 ) = PACK(InData%Marker2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Marker2) + DO i1 = LBOUND(InData%Marker2,1), UBOUND(InData%Marker2,1) + IntKiBuf(Int_Xferred) = InData%Marker2(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%s) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2955,8 +2877,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%s)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%s))-1 ) = PACK(InData%s,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%s) + DO i1 = LBOUND(InData%s,1), UBOUND(InData%s,1) + ReKiBuf(Re_Xferred) = InData%s(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_PackMOutput @@ -2973,12 +2897,6 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2993,10 +2911,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeLocs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3010,18 +2928,13 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeLocs)>0) OutData%NodeLocs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NodeLocs))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%NodeLocs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeLocs,1), UBOUND(OutData%NodeLocs,1) + OutData%NodeLocs(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%MemberIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Marker1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3035,15 +2948,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Marker1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Marker1)>0) OutData%Marker1 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Marker1))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Marker1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Marker1,1), UBOUND(OutData%Marker1,1) + OutData%Marker1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Marker2 not allocated Int_Xferred = Int_Xferred + 1 @@ -3058,15 +2966,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Marker2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Marker2)>0) OutData%Marker2 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Marker2))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Marker2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Marker2,1), UBOUND(OutData%Marker2,1) + OutData%Marker2(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s not allocated Int_Xferred = Int_Xferred + 1 @@ -3081,15 +2984,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%s)>0) OutData%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%s))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%s,1), UBOUND(OutData%s,1) + OutData%s(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_UnPackMOutput @@ -3191,14 +3089,16 @@ SUBROUTINE Morison_PackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumMarkers - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Markers))-1 ) = PACK(InData%Markers,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Markers) + IntKiBuf(Int_Xferred) = InData%JointID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumMarkers + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Markers,1), UBOUND(InData%Markers,1) + IntKiBuf(Int_Xferred) = InData%Markers(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_PackJOutput SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3214,12 +3114,6 @@ SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3234,23 +3128,18 @@ SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%JointID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%JointID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Markers,1) i1_u = UBOUND(OutData%Markers,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Markers = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Markers))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Markers) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Markers,1), UBOUND(OutData%Markers,1) + OutData%Markers(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_UnPackJOutput SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4092,20 +3981,20 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TotalPossibleSuperMembers - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TotalPossibleSuperMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpJoints) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4188,8 +4077,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NElements - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NElements + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Elements) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4231,8 +4120,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAxCoefs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAxCoefs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AxialCoefs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4274,8 +4163,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSets + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MPropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4317,28 +4206,28 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCpMG - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCoefDpth - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCpMG + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCoefDpth + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CoefDpths) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4380,8 +4269,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCoefMembers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCoefMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CoefMembers) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4423,8 +4312,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMembers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpMembers) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4466,8 +4355,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFillGroups - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFillGroups + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FilledGroups) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4509,8 +4398,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMGDepths - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMGDepths + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MGDepths) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4552,12 +4441,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGTop - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGBottom - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGTop + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGBottom + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4599,8 +4488,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4643,11 +4532,11 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END IF DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( .NOT. ALLOCATED(InData%ValidOutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4658,25 +4547,27 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidOutList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ValidOutList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ValidOutList)-1 ) = TRANSFER(PACK( InData%ValidOutList ,.TRUE.), IntKiBuf(1), SIZE(InData%ValidOutList)) - Int_Xferred = Int_Xferred + SIZE(InData%ValidOutList) + DO i1 = LBOUND(InData%ValidOutList,1), UBOUND(InData%ValidOutList,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidOutList(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4693,8 +4584,14 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4706,8 +4603,10 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4722,8 +4621,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4741,8 +4644,14 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4757,8 +4666,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE Morison_PackInitInput @@ -4775,12 +4688,6 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4797,20 +4704,20 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NJoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TotalPossibleSuperMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TotalPossibleSuperMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4923,8 +4830,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NElements = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NElements = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elements not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4981,8 +4888,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NAxCoefs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NAxCoefs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxialCoefs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5039,8 +4946,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MPropSets not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5097,28 +5004,28 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%SimplCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NCoefDpth = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SimplCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NCoefDpth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefDpths not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5175,8 +5082,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NCoefMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NCoefMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefMembers not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5233,8 +5140,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpMembers not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5291,8 +5198,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NFillGroups = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NFillGroups = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FilledGroups not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5349,8 +5256,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NMGDepths = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMGDepths = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGDepths not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5407,12 +5314,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%MGTop = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGBottom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MGTop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGBottom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5469,8 +5376,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NJOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5529,19 +5436,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END IF i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidOutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5555,32 +5455,27 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidOutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ValidOutList)>0) OutData%ValidOutList = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ValidOutList))-1 ), OutData%ValidOutList), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ValidOutList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ValidOutList,1), UBOUND(OutData%ValidOutList,1) + OutData%ValidOutList(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidOutList(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5600,15 +5495,14 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -5623,15 +5517,10 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -5649,15 +5538,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -5678,15 +5564,14 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 @@ -5704,15 +5589,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE Morison_UnPackInitInput @@ -5975,8 +5857,10 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Morison_Rad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Morison_Rad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Morison_Rad))-1 ) = PACK(InData%Morison_Rad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Morison_Rad) + DO i1 = LBOUND(InData%Morison_Rad,1), UBOUND(InData%Morison_Rad,1) + ReKiBuf(Re_Xferred) = InData%Morison_Rad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5988,12 +5872,12 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6005,12 +5889,12 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE Morison_PackInitOutput @@ -6027,12 +5911,6 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6140,15 +6018,10 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Morison_Rad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Morison_Rad)>0) OutData%Morison_Rad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Morison_Rad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%Morison_Rad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Morison_Rad,1), UBOUND(OutData%Morison_Rad,1) + OutData%Morison_Rad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 @@ -6163,19 +6036,12 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -6190,19 +6056,12 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE Morison_UnPackInitOutput @@ -6297,8 +6156,8 @@ SUBROUTINE Morison_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackContState SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6314,12 +6173,6 @@ SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackContState' @@ -6333,8 +6186,8 @@ SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackContState SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6428,8 +6281,8 @@ SUBROUTINE Morison_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackDiscState SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6445,12 +6298,6 @@ SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackDiscState' @@ -6464,8 +6311,8 @@ SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackDiscState SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6559,8 +6406,8 @@ SUBROUTINE Morison_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackConstrState SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6576,12 +6423,6 @@ SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackConstrState' @@ -6595,8 +6436,8 @@ SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackConstrState SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6690,8 +6531,8 @@ SUBROUTINE Morison_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackOtherState SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6707,12 +6548,6 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackOtherState' @@ -6726,8 +6561,8 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackOtherState SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -7228,8 +7063,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_D))-1 ) = PACK(InData%D_F_D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_D) + DO i2 = LBOUND(InData%D_F_D,2), UBOUND(InData%D_F_D,2) + DO i1 = LBOUND(InData%D_F_D,1), UBOUND(InData%D_F_D,1) + ReKiBuf(Re_Xferred) = InData%D_F_D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7244,8 +7083,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_I,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_I))-1 ) = PACK(InData%D_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_I) + DO i2 = LBOUND(InData%D_F_I,2), UBOUND(InData%D_F_I,2) + DO i1 = LBOUND(InData%D_F_I,1), UBOUND(InData%D_F_I,1) + ReKiBuf(Re_Xferred) = InData%D_F_I(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7260,8 +7103,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_B))-1 ) = PACK(InData%D_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_B) + DO i2 = LBOUND(InData%D_F_B,2), UBOUND(InData%D_F_B,2) + DO i1 = LBOUND(InData%D_F_B,1), UBOUND(InData%D_F_B,1) + ReKiBuf(Re_Xferred) = InData%D_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7276,8 +7123,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM))-1 ) = PACK(InData%D_F_AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM) + DO i2 = LBOUND(InData%D_F_AM,2), UBOUND(InData%D_F_AM,2) + DO i1 = LBOUND(InData%D_F_AM,1), UBOUND(InData%D_F_AM,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7292,8 +7143,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_M))-1 ) = PACK(InData%D_F_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_M) + DO i2 = LBOUND(InData%D_F_AM_M,2), UBOUND(InData%D_F_AM_M,2) + DO i1 = LBOUND(InData%D_F_AM_M,1), UBOUND(InData%D_F_AM_M,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7308,8 +7163,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_MG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_MG))-1 ) = PACK(InData%D_F_AM_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_MG) + DO i2 = LBOUND(InData%D_F_AM_MG,2), UBOUND(InData%D_F_AM_MG,2) + DO i1 = LBOUND(InData%D_F_AM_MG,1), UBOUND(InData%D_F_AM_MG,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_MG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7324,8 +7183,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_F))-1 ) = PACK(InData%D_F_AM_F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_F) + DO i2 = LBOUND(InData%D_F_AM_F,2), UBOUND(InData%D_F_AM_F,2) + DO i1 = LBOUND(InData%D_F_AM_F,1), UBOUND(InData%D_F_AM_F,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_F(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7340,8 +7203,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FV))-1 ) = PACK(InData%D_FV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FV) + DO i2 = LBOUND(InData%D_FV,2), UBOUND(InData%D_FV,2) + DO i1 = LBOUND(InData%D_FV,1), UBOUND(InData%D_FV,1) + ReKiBuf(Re_Xferred) = InData%D_FV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7356,8 +7223,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FA))-1 ) = PACK(InData%D_FA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FA) + DO i2 = LBOUND(InData%D_FA,2), UBOUND(InData%D_FA,2) + DO i1 = LBOUND(InData%D_FA,1), UBOUND(InData%D_FA,1) + ReKiBuf(Re_Xferred) = InData%D_FA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7369,8 +7240,10 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FDynP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FDynP))-1 ) = PACK(InData%D_FDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FDynP) + DO i1 = LBOUND(InData%D_FDynP,1), UBOUND(InData%D_FDynP,1) + ReKiBuf(Re_Xferred) = InData%D_FDynP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7385,8 +7258,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_B))-1 ) = PACK(InData%L_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_B) + DO i2 = LBOUND(InData%L_F_B,2), UBOUND(InData%L_F_B,2) + DO i1 = LBOUND(InData%L_F_B,1), UBOUND(InData%L_F_B,1) + ReKiBuf(Re_Xferred) = InData%L_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7401,8 +7278,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_D))-1 ) = PACK(InData%L_F_D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_D) + DO i2 = LBOUND(InData%L_F_D,2), UBOUND(InData%L_F_D,2) + DO i1 = LBOUND(InData%L_F_D,1), UBOUND(InData%L_F_D,1) + ReKiBuf(Re_Xferred) = InData%L_F_D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7417,8 +7298,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_I,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_I))-1 ) = PACK(InData%L_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_I) + DO i2 = LBOUND(InData%L_F_I,2), UBOUND(InData%L_F_I,2) + DO i1 = LBOUND(InData%L_F_I,1), UBOUND(InData%L_F_I,1) + ReKiBuf(Re_Xferred) = InData%L_F_I(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7433,8 +7318,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_DP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_DP))-1 ) = PACK(InData%L_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_DP) + DO i2 = LBOUND(InData%L_F_DP,2), UBOUND(InData%L_F_DP,2) + DO i1 = LBOUND(InData%L_F_DP,1), UBOUND(InData%L_F_DP,1) + ReKiBuf(Re_Xferred) = InData%L_F_DP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_AM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7449,8 +7338,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_AM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_AM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_AM))-1 ) = PACK(InData%L_F_AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_AM) + DO i2 = LBOUND(InData%L_F_AM,2), UBOUND(InData%L_F_AM,2) + DO i1 = LBOUND(InData%L_F_AM,1), UBOUND(InData%L_F_AM,1) + ReKiBuf(Re_Xferred) = InData%L_F_AM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7465,8 +7358,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FV))-1 ) = PACK(InData%L_FV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FV) + DO i2 = LBOUND(InData%L_FV,2), UBOUND(InData%L_FV,2) + DO i1 = LBOUND(InData%L_FV,1), UBOUND(InData%L_FV,1) + ReKiBuf(Re_Xferred) = InData%L_FV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7481,8 +7378,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FA))-1 ) = PACK(InData%L_FA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FA) + DO i2 = LBOUND(InData%L_FA,2), UBOUND(InData%L_FA,2) + DO i1 = LBOUND(InData%L_FA,1), UBOUND(InData%L_FA,1) + ReKiBuf(Re_Xferred) = InData%L_FA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7494,11 +7395,13 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FDynP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FDynP))-1 ) = PACK(InData%L_FDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FDynP) + DO i1 = LBOUND(InData%L_FDynP,1), UBOUND(InData%L_FDynP,1) + ReKiBuf(Re_Xferred) = InData%L_FDynP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackMisc SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7514,12 +7417,6 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7551,15 +7448,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_D)>0) OutData%D_F_D = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_D))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_D,2), UBOUND(OutData%D_F_D,2) + DO i1 = LBOUND(OutData%D_F_D,1), UBOUND(OutData%D_F_D,1) + OutData%D_F_D(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -7577,15 +7471,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_I)>0) OutData%D_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_I))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_I) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_I,2), UBOUND(OutData%D_F_I,2) + DO i1 = LBOUND(OutData%D_F_I,1), UBOUND(OutData%D_F_I,1) + OutData%D_F_I(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -7603,15 +7494,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_B)>0) OutData%D_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_B,2), UBOUND(OutData%D_F_B,2) + DO i1 = LBOUND(OutData%D_F_B,1), UBOUND(OutData%D_F_B,1) + OutData%D_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM not allocated Int_Xferred = Int_Xferred + 1 @@ -7629,15 +7517,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM)>0) OutData%D_F_AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM,2), UBOUND(OutData%D_F_AM,2) + DO i1 = LBOUND(OutData%D_F_AM,1), UBOUND(OutData%D_F_AM,1) + OutData%D_F_AM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -7655,15 +7540,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_M)>0) OutData%D_F_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_M,2), UBOUND(OutData%D_F_AM_M,2) + DO i1 = LBOUND(OutData%D_F_AM_M,1), UBOUND(OutData%D_F_AM_M,1) + OutData%D_F_AM_M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -7681,15 +7563,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_MG)>0) OutData%D_F_AM_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_MG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_MG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_MG,2), UBOUND(OutData%D_F_AM_MG,2) + DO i1 = LBOUND(OutData%D_F_AM_MG,1), UBOUND(OutData%D_F_AM_MG,1) + OutData%D_F_AM_MG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_F not allocated Int_Xferred = Int_Xferred + 1 @@ -7707,15 +7586,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_F)>0) OutData%D_F_AM_F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_F))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_F,2), UBOUND(OutData%D_F_AM_F,2) + DO i1 = LBOUND(OutData%D_F_AM_F,1), UBOUND(OutData%D_F_AM_F,1) + OutData%D_F_AM_F(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FV not allocated Int_Xferred = Int_Xferred + 1 @@ -7733,15 +7609,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_FV)>0) OutData%D_FV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_FV,2), UBOUND(OutData%D_FV,2) + DO i1 = LBOUND(OutData%D_FV,1), UBOUND(OutData%D_FV,1) + OutData%D_FV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FA not allocated Int_Xferred = Int_Xferred + 1 @@ -7759,15 +7632,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_FA)>0) OutData%D_FA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_FA,2), UBOUND(OutData%D_FA,2) + DO i1 = LBOUND(OutData%D_FA,1), UBOUND(OutData%D_FA,1) + OutData%D_FA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -7782,15 +7652,10 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_FDynP)>0) OutData%D_FDynP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FDynP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FDynP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_FDynP,1), UBOUND(OutData%D_FDynP,1) + OutData%D_FDynP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -7808,15 +7673,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_B)>0) OutData%L_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_B,2), UBOUND(OutData%L_F_B,2) + DO i1 = LBOUND(OutData%L_F_B,1), UBOUND(OutData%L_F_B,1) + OutData%L_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_D not allocated Int_Xferred = Int_Xferred + 1 @@ -7834,15 +7696,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_D)>0) OutData%L_F_D = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_D))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_D,2), UBOUND(OutData%L_F_D,2) + DO i1 = LBOUND(OutData%L_F_D,1), UBOUND(OutData%L_F_D,1) + OutData%L_F_D(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -7860,15 +7719,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_I)>0) OutData%L_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_I))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_I) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_I,2), UBOUND(OutData%L_F_I,2) + DO i1 = LBOUND(OutData%L_F_I,1), UBOUND(OutData%L_F_I,1) + OutData%L_F_I(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -7886,15 +7742,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_DP)>0) OutData%L_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_DP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_DP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_DP,2), UBOUND(OutData%L_F_DP,2) + DO i1 = LBOUND(OutData%L_F_DP,1), UBOUND(OutData%L_F_DP,1) + OutData%L_F_DP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_AM not allocated Int_Xferred = Int_Xferred + 1 @@ -7912,15 +7765,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_AM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_AM)>0) OutData%L_F_AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_AM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_AM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_AM,2), UBOUND(OutData%L_F_AM,2) + DO i1 = LBOUND(OutData%L_F_AM,1), UBOUND(OutData%L_F_AM,1) + OutData%L_F_AM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FV not allocated Int_Xferred = Int_Xferred + 1 @@ -7938,15 +7788,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_FV)>0) OutData%L_FV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_FV,2), UBOUND(OutData%L_FV,2) + DO i1 = LBOUND(OutData%L_FV,1), UBOUND(OutData%L_FV,1) + OutData%L_FV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FA not allocated Int_Xferred = Int_Xferred + 1 @@ -7964,15 +7811,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_FA)>0) OutData%L_FA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_FA,2), UBOUND(OutData%L_FA,2) + DO i1 = LBOUND(OutData%L_FA,1), UBOUND(OutData%L_FA,1) + OutData%L_FA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -7987,18 +7831,13 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%L_FDynP)>0) OutData%L_FDynP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FDynP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FDynP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%L_FDynP,1), UBOUND(OutData%L_FDynP,1) + OutData%L_FDynP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackMisc SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -8854,12 +8693,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8917,8 +8756,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_I,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_I))-1 ) = PACK(InData%D_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_I) + DO i3 = LBOUND(InData%D_F_I,3), UBOUND(InData%D_F_I,3) + DO i2 = LBOUND(InData%D_F_I,2), UBOUND(InData%D_F_I,2) + DO i1 = LBOUND(InData%D_F_I,1), UBOUND(InData%D_F_I,1) + ReKiBuf(Re_Xferred) = InData%D_F_I(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8936,8 +8781,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_DP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_DP))-1 ) = PACK(InData%D_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_DP) + DO i3 = LBOUND(InData%D_F_DP,3), UBOUND(InData%D_F_DP,3) + DO i2 = LBOUND(InData%D_F_DP,2), UBOUND(InData%D_F_DP,2) + DO i1 = LBOUND(InData%D_F_DP,1), UBOUND(InData%D_F_DP,1) + ReKiBuf(Re_Xferred) = InData%D_F_DP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_dragConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8949,8 +8800,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_dragConst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_dragConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_dragConst))-1 ) = PACK(InData%D_dragConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_dragConst) + DO i1 = LBOUND(InData%D_dragConst,1), UBOUND(InData%D_dragConst,1) + ReKiBuf(Re_Xferred) = InData%D_dragConst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%L_An) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8965,8 +8818,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_An,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_An)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_An))-1 ) = PACK(InData%L_An,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_An) + DO i2 = LBOUND(InData%L_An,2), UBOUND(InData%L_An,2) + DO i1 = LBOUND(InData%L_An,1), UBOUND(InData%L_An,1) + ReKiBuf(Re_Xferred) = InData%L_An(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8981,8 +8838,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_B))-1 ) = PACK(InData%L_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_B) + DO i2 = LBOUND(InData%L_F_B,2), UBOUND(InData%L_F_B,2) + DO i1 = LBOUND(InData%L_F_B,1), UBOUND(InData%L_F_B,1) + ReKiBuf(Re_Xferred) = InData%L_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9000,8 +8861,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_I,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_I))-1 ) = PACK(InData%L_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_I) + DO i3 = LBOUND(InData%L_F_I,3), UBOUND(InData%L_F_I,3) + DO i2 = LBOUND(InData%L_F_I,2), UBOUND(InData%L_F_I,2) + DO i1 = LBOUND(InData%L_F_I,1), UBOUND(InData%L_F_I,1) + ReKiBuf(Re_Xferred) = InData%L_F_I(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9019,8 +8886,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_DP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_DP))-1 ) = PACK(InData%L_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_DP) + DO i3 = LBOUND(InData%L_F_DP,3), UBOUND(InData%L_F_DP,3) + DO i2 = LBOUND(InData%L_F_DP,2), UBOUND(InData%L_F_DP,2) + DO i1 = LBOUND(InData%L_F_DP,1), UBOUND(InData%L_F_DP,1) + ReKiBuf(Re_Xferred) = InData%L_F_DP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_BF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9035,8 +8908,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_BF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_BF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_BF))-1 ) = PACK(InData%L_F_BF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_BF) + DO i2 = LBOUND(InData%L_F_BF,2), UBOUND(InData%L_F_BF,2) + DO i1 = LBOUND(InData%L_F_BF,1), UBOUND(InData%L_F_BF,1) + ReKiBuf(Re_Xferred) = InData%L_F_BF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9054,8 +8931,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_AM_M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_AM_M))-1 ) = PACK(InData%L_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_AM_M) + DO i3 = LBOUND(InData%L_AM_M,3), UBOUND(InData%L_AM_M,3) + DO i2 = LBOUND(InData%L_AM_M,2), UBOUND(InData%L_AM_M,2) + DO i1 = LBOUND(InData%L_AM_M,1), UBOUND(InData%L_AM_M,1) + ReKiBuf(Re_Xferred) = InData%L_AM_M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_dragConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9067,11 +8950,13 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_dragConst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_dragConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_dragConst))-1 ) = PACK(InData%L_dragConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_dragConst) + DO i1 = LBOUND(InData%L_dragConst,1), UBOUND(InData%L_dragConst,1) + ReKiBuf(Re_Xferred) = InData%L_dragConst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDistribMarkers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDistribMarkers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%distribToNodeIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9082,11 +8967,13 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%distribToNodeIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%distribToNodeIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%distribToNodeIndx))-1 ) = PACK(InData%distribToNodeIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%distribToNodeIndx) + DO i1 = LBOUND(InData%distribToNodeIndx,1), UBOUND(InData%distribToNodeIndx,1) + IntKiBuf(Int_Xferred) = InData%distribToNodeIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NLumpedMarkers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLumpedMarkers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%lumpedToNodeIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9097,8 +8984,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lumpedToNodeIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lumpedToNodeIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%lumpedToNodeIndx))-1 ) = PACK(InData%lumpedToNodeIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%lumpedToNodeIndx) + DO i1 = LBOUND(InData%lumpedToNodeIndx,1), UBOUND(InData%lumpedToNodeIndx,1) + IntKiBuf(Int_Xferred) = InData%lumpedToNodeIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9116,8 +9005,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + 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 @@ -9135,8 +9030,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + 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 @@ -9151,8 +9052,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9164,8 +9069,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%elementWaterState) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9180,8 +9087,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elementWaterState,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elementWaterState)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%elementWaterState))-1 ) = PACK(InData%elementWaterState,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%elementWaterState) + DO i2 = LBOUND(InData%elementWaterState,2), UBOUND(InData%elementWaterState,2) + DO i1 = LBOUND(InData%elementWaterState,1), UBOUND(InData%elementWaterState,1) + IntKiBuf(Int_Xferred) = InData%elementWaterState(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elementFillState) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9193,8 +9104,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elementFillState,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elementFillState)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%elementFillState))-1 ) = PACK(InData%elementFillState,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%elementFillState) + DO i1 = LBOUND(InData%elementFillState,1), UBOUND(InData%elementFillState,1) + IntKiBuf(Int_Xferred) = InData%elementFillState(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9209,8 +9122,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9225,8 +9142,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_B))-1 ) = PACK(InData%D_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_B) + DO i2 = LBOUND(InData%D_F_B,2), UBOUND(InData%D_F_B,2) + DO i1 = LBOUND(InData%D_F_B,1), UBOUND(InData%D_F_B,1) + ReKiBuf(Re_Xferred) = InData%D_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_BF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9241,8 +9162,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_BF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_BF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_BF))-1 ) = PACK(InData%D_F_BF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_BF) + DO i2 = LBOUND(InData%D_F_BF,2), UBOUND(InData%D_F_BF,2) + DO i1 = LBOUND(InData%D_F_BF,1), UBOUND(InData%D_F_BF,1) + ReKiBuf(Re_Xferred) = InData%D_F_BF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9257,8 +9182,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_MG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_MG))-1 ) = PACK(InData%D_F_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_MG) + DO i2 = LBOUND(InData%D_F_MG,2), UBOUND(InData%D_F_MG,2) + DO i1 = LBOUND(InData%D_F_MG,1), UBOUND(InData%D_F_MG,1) + ReKiBuf(Re_Xferred) = InData%D_F_MG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9276,8 +9205,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_M))-1 ) = PACK(InData%D_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_M) + DO i3 = LBOUND(InData%D_AM_M,3), UBOUND(InData%D_AM_M,3) + DO i2 = LBOUND(InData%D_AM_M,2), UBOUND(InData%D_AM_M,2) + DO i1 = LBOUND(InData%D_AM_M,1), UBOUND(InData%D_AM_M,1) + ReKiBuf(Re_Xferred) = InData%D_AM_M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9289,8 +9224,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_MG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_MG))-1 ) = PACK(InData%D_AM_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_MG) + DO i1 = LBOUND(InData%D_AM_MG,1), UBOUND(InData%D_AM_MG,1) + ReKiBuf(Re_Xferred) = InData%D_AM_MG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9302,13 +9239,15 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_F,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_F))-1 ) = PACK(InData%D_AM_F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_F) + DO i1 = LBOUND(InData%D_AM_F,1), UBOUND(InData%D_AM_F,1) + ReKiBuf(Re_Xferred) = InData%D_AM_F(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9350,8 +9289,8 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9434,26 +9373,26 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Morison_PackParam SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9469,12 +9408,6 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -9491,12 +9424,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9572,15 +9505,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_F_I)>0) OutData%D_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_I))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_I) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_F_I,3), UBOUND(OutData%D_F_I,3) + DO i2 = LBOUND(OutData%D_F_I,2), UBOUND(OutData%D_F_I,2) + DO i1 = LBOUND(OutData%D_F_I,1), UBOUND(OutData%D_F_I,1) + OutData%D_F_I(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -9601,15 +9533,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_F_DP)>0) OutData%D_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_DP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_DP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_F_DP,3), UBOUND(OutData%D_F_DP,3) + DO i2 = LBOUND(OutData%D_F_DP,2), UBOUND(OutData%D_F_DP,2) + DO i1 = LBOUND(OutData%D_F_DP,1), UBOUND(OutData%D_F_DP,1) + OutData%D_F_DP(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_dragConst not allocated Int_Xferred = Int_Xferred + 1 @@ -9624,15 +9555,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_dragConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_dragConst)>0) OutData%D_dragConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_dragConst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_dragConst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_dragConst,1), UBOUND(OutData%D_dragConst,1) + OutData%D_dragConst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_An not allocated Int_Xferred = Int_Xferred + 1 @@ -9650,15 +9576,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_An.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_An)>0) OutData%L_An = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_An))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_An) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_An,2), UBOUND(OutData%L_An,2) + DO i1 = LBOUND(OutData%L_An,1), UBOUND(OutData%L_An,1) + OutData%L_An(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -9676,15 +9599,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_B)>0) OutData%L_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_B,2), UBOUND(OutData%L_F_B,2) + DO i1 = LBOUND(OutData%L_F_B,1), UBOUND(OutData%L_F_B,1) + OutData%L_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -9705,15 +9625,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_F_I)>0) OutData%L_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_I))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_I) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_F_I,3), UBOUND(OutData%L_F_I,3) + DO i2 = LBOUND(OutData%L_F_I,2), UBOUND(OutData%L_F_I,2) + DO i1 = LBOUND(OutData%L_F_I,1), UBOUND(OutData%L_F_I,1) + OutData%L_F_I(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 ! L_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -9734,15 +9653,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_F_DP)>0) OutData%L_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_DP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_DP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_F_DP,3), UBOUND(OutData%L_F_DP,3) + DO i2 = LBOUND(OutData%L_F_DP,2), UBOUND(OutData%L_F_DP,2) + DO i1 = LBOUND(OutData%L_F_DP,1), UBOUND(OutData%L_F_DP,1) + OutData%L_F_DP(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 ! L_F_BF not allocated Int_Xferred = Int_Xferred + 1 @@ -9760,15 +9678,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_BF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_BF)>0) OutData%L_F_BF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_BF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_BF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_BF,2), UBOUND(OutData%L_F_BF,2) + DO i1 = LBOUND(OutData%L_F_BF,1), UBOUND(OutData%L_F_BF,1) + OutData%L_F_BF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -9789,15 +9704,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_AM_M)>0) OutData%L_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_AM_M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_AM_M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_AM_M,3), UBOUND(OutData%L_AM_M,3) + DO i2 = LBOUND(OutData%L_AM_M,2), UBOUND(OutData%L_AM_M,2) + DO i1 = LBOUND(OutData%L_AM_M,1), UBOUND(OutData%L_AM_M,1) + OutData%L_AM_M(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 ! L_dragConst not allocated Int_Xferred = Int_Xferred + 1 @@ -9812,18 +9726,13 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_dragConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%L_dragConst)>0) OutData%L_dragConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_dragConst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_dragConst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%L_dragConst,1), UBOUND(OutData%L_dragConst,1) + OutData%L_dragConst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NDistribMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NDistribMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! distribToNodeIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9837,18 +9746,13 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%distribToNodeIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%distribToNodeIndx)>0) OutData%distribToNodeIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%distribToNodeIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%distribToNodeIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%distribToNodeIndx,1), UBOUND(OutData%distribToNodeIndx,1) + OutData%distribToNodeIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NLumpedMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NLumpedMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lumpedToNodeIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9862,15 +9766,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lumpedToNodeIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lumpedToNodeIndx)>0) OutData%lumpedToNodeIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%lumpedToNodeIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%lumpedToNodeIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lumpedToNodeIndx,1), UBOUND(OutData%lumpedToNodeIndx,1) + OutData%lumpedToNodeIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -9891,15 +9790,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 @@ -9920,15 +9818,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -9946,15 +9843,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -9969,15 +9863,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elementWaterState not allocated Int_Xferred = Int_Xferred + 1 @@ -9995,15 +9884,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elementWaterState.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%elementWaterState)>0) OutData%elementWaterState = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%elementWaterState))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%elementWaterState) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%elementWaterState,2), UBOUND(OutData%elementWaterState,2) + DO i1 = LBOUND(OutData%elementWaterState,1), UBOUND(OutData%elementWaterState,1) + OutData%elementWaterState(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elementFillState not allocated Int_Xferred = Int_Xferred + 1 @@ -10018,15 +9904,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elementFillState.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%elementFillState)>0) OutData%elementFillState = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%elementFillState))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%elementFillState) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%elementFillState,1), UBOUND(OutData%elementFillState,1) + OutData%elementFillState(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 @@ -10044,15 +9925,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -10070,15 +9948,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_B)>0) OutData%D_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_B,2), UBOUND(OutData%D_F_B,2) + DO i1 = LBOUND(OutData%D_F_B,1), UBOUND(OutData%D_F_B,1) + OutData%D_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_BF not allocated Int_Xferred = Int_Xferred + 1 @@ -10096,15 +9971,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_BF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_BF)>0) OutData%D_F_BF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_BF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_BF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_BF,2), UBOUND(OutData%D_F_BF,2) + DO i1 = LBOUND(OutData%D_F_BF,1), UBOUND(OutData%D_F_BF,1) + OutData%D_F_BF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -10122,15 +9994,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_MG)>0) OutData%D_F_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_MG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_MG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_MG,2), UBOUND(OutData%D_F_MG,2) + DO i1 = LBOUND(OutData%D_F_MG,1), UBOUND(OutData%D_F_MG,1) + OutData%D_F_MG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -10151,15 +10020,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_AM_M)>0) OutData%D_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_AM_M,3), UBOUND(OutData%D_AM_M,3) + DO i2 = LBOUND(OutData%D_AM_M,2), UBOUND(OutData%D_AM_M,2) + DO i1 = LBOUND(OutData%D_AM_M,1), UBOUND(OutData%D_AM_M,1) + OutData%D_AM_M(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -10174,15 +10042,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_AM_MG)>0) OutData%D_AM_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_MG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_MG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_AM_MG,1), UBOUND(OutData%D_AM_MG,1) + OutData%D_AM_MG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_F not allocated Int_Xferred = Int_Xferred + 1 @@ -10197,20 +10060,15 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_AM_F)>0) OutData%D_AM_F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_F))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_F) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_AM_F,1), UBOUND(OutData%D_AM_F,1) + OutData%D_AM_F(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10267,8 +10125,8 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NJOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10381,26 +10239,26 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Morison_UnPackParam SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -10606,12 +10464,6 @@ SUBROUTINE Morison_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInput' @@ -10926,8 +10778,10 @@ SUBROUTINE Morison_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_PackOutput @@ -10944,12 +10798,6 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -11057,15 +10905,10 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_UnPackOutput @@ -11144,8 +10987,8 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -11160,6 +11003,8 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%DistribMesh, u2%DistribMesh, tin, u_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%LumpedMesh, u2%LumpedMesh, tin, u_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -11193,8 +11038,9 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp2' @@ -11216,6 +11062,8 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%DistribMesh, u2%DistribMesh, u3%DistribMesh, tin, u_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%LumpedMesh, u2%LumpedMesh, u3%LumpedMesh, tin, u_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -11297,12 +11145,12 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -11315,17 +11163,17 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%DistribMesh, y2%DistribMesh, tin, y_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%LumpedMesh, y2%LumpedMesh, tin, y_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Morison_Output_ExtrapInterp1 @@ -11356,13 +11204,14 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -11381,18 +11230,18 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%DistribMesh, y2%DistribMesh, y3%DistribMesh, tin, y_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%LumpedMesh, y2%LumpedMesh, y3%LumpedMesh, tin, y_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Morison_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 new file mode 100644 index 0000000000..f2071c1db1 --- /dev/null +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -0,0 +1,901 @@ +!********************************************************************************************************************************** +! The SS_Excitation and SS_Excitation_Types modules make up a template for creating user-defined calculations in the FAST Modularization +! Framework. SS_Excitations_Types will be auto-generated based on a description of the variables for the module. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2012, 2018 National Renewable Energy Laboratory +! +! This file is part of SS_Excitation. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! +!********************************************************************************************************************************** +MODULE SS_Excitation + + USE SS_Excitation_Types + USE NWTC_Library + + IMPLICIT NONE + + PRIVATE + + TYPE(ProgDesc), PARAMETER :: SS_Exc_ProgDesc = ProgDesc( 'SS_Excitation', '', '' ) + + + ! ..... Public Subroutines ................................................................................................... + + PUBLIC :: SS_Exc_Init ! Initialization routine + PUBLIC :: SS_Exc_End ! Ending routine (includes clean up) + + PUBLIC :: SS_Exc_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + PUBLIC :: SS_Exc_CalcOutput ! Routine for computing outputs + + PUBLIC :: SS_Exc_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual + PUBLIC :: SS_Exc_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states + PUBLIC :: SS_Exc_UpdateDiscState ! Tight coupling routine for updating discrete states + + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The parameters are set here and not changed during the simulation. +!! The initial states and initial guess for the input are defined. +SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(SS_Exc_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(SS_Exc_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SS_Exc_ParameterType), INTENT( OUT) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states + TYPE(SS_Exc_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states + TYPE(SS_Exc_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states + TYPE(SS_Exc_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states + TYPE(SS_Exc_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + TYPE(SS_Exc_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables + REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that + !! (1) SS_Exc_UpdateStates() is called in loose coupling & + !! (2) SS_Exc_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. + TYPE(SS_Exc_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local Variables: + + INTEGER :: I ! Generic index +! INTEGER :: J ! Generic index + INTEGER :: xx (1,6) ! Active DOF's on the input file .ss + INTEGER :: Nlines ! Number of lines in the input file, used to determine N + INTEGER :: UnSS ! I/O unit number for the WAMIT output file with the .ss extension; this file contains the state-space matrices. + INTEGER :: Sttus ! Error in reading .ssexctn file + !CHARACTER :: Line ! Temp line of file + real(ReKi) :: WaveDir ! Temp wave direction angle (deg) + integer :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + u%DummyInput = 0.0_ReKi + + UnSS = -1 + p%N = 0 + + ! Open the .ss input file! + CALL GetNewUnit( UnSS ) + CALL OpenFInpFile ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', ErrStat2, ErrMsg2 ) ! Open file. + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + + ! Determine the number of states and size of the matrices + Nlines = 1 + + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + + CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + + ! Check that excitation state-space file Beta angle (in degrees) matches the HydroDyn input file angle + if ( .not. EqualRealNos(InitInp%WaveDir, WaveDir) ) call SetErrStat(ErrID_FATAL,'HydroDyn Wave direction does not match the wave excitation wave direction',ErrStat,ErrMsg,'SS_Exc_Init') + + CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%Tc, 'p%Tc', 'Time offset (s)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + + CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%N, 'p%N', 'Number of states',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + + CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%spDOF, 6, 'p%spDOF', 'States per DOF',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + + DO !Loop through all the lines of the file + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',Sttus,ErrMsg2 )! Reads the first entire line (Title header) + IF ( Sttus == ErrID_None ) THEN ! .TRUE. when data is read in successfully + Nlines=Nlines+1 + ELSE !We must have reached the end of the file + EXIT + END IF + END DO + + ! The input file contains the matrices A [NxN], B [Nx1] and C [6xN], so + !p%N = ( Nlines - 1 ) / 2 ! this is the number of states + + !Verifications on the input file + IF ( ( Nlines - 6 ) / 2 /= p%N) THEN + CALL SetErrStat(ErrID_Severe,'Error in the input file .ssexctn: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,'SS_Exc_Init') + END IF + + + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + + ! Now we can allocate the temporary matrices A, B and C + + CALL AllocAry( p%A, p%N, p%N, 'p%A', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL AllocAry( p%B, p%N, 'p%B', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL AllocAry( p%C, 6, p%N, 'p%C', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + + + REWIND (UNIT=UnSS) ! REWIND the file so we can read it in a second time. + + ! Skip the first 4 lines: (NOTE: no error handling here because we would have caught it the first time through) + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Wave direction (deg)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Time offset (s)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Number of Excitation States', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Number of states per dofs', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + + DO I = 1,p%N !Read A MatriX + CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%A(I,:), p%N, 'p%A', 'A_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + END DO + + DO I = 1,p%N !Read B Matrix + CALL ReadVar( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', p%B(I), 'p%B', 'B_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + END DO + + DO I = 1,6 !Read C Matrix + CALL ReadAry( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', p%C(I,:), p%N, 'p%C', 'C_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + END DO + CLOSE ( UnSS ) !Close .ss input file + UnSS = -1 ! Indicate the file is closed + + + CALL WrScr1 ( 'Using SS_Excitation Module, with '//TRIM( Num2LStr(p%N ))//' excitation states' ) + + ! Define parameters here: + + p%DT = Interval + + ! Allocate Wave-elevation related arrays + p%NStepWave = InitInp%NStepWave + allocate ( p%WaveElev0(0:p%NStepWave) , STAT=ErrStat2 ) + allocate ( p%WaveTime (0:p%NStepWave) , STAT=ErrStat2 ) +!TODO: Error Handling + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + p%WaveTime = InitInp%WaveTime + p%WaveElev0 = InitInp%WaveElev0 + + ! Define initial system states here: + CALL AllocAry( x%x, p%N, 'x%x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + RETURN + END IF + + x%x = 0 + + xd%DummyDiscState = 0 !TD: SS doesn't have disc states + z%DummyConstrState = 0 !TD: SS doesn't have constr states + + ! Define other States: + DO I=1,SIZE(OtherState%xdot) + CALL SS_Exc_CopyContState( x, OtherState%xdot(i), MESH_NEWCOPY, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + END DO + OtherState%n = -1 + + ! misc vars: + + + ! Inputs + ! no inputs + + ! Define system output initializations (set up mesh) here: + + y%y = 0 + y%WriteOutput = 0 + + + ! Define initialization-routine output here: + + InitOut%WriteOutputHdr = (/ 'Time', 'FX ' , 'FY ' , 'FZ ' , 'MX ' , 'MY ' , 'MZ ' /) + InitOut%WriteOutputUnt = (/ '(s) ', '(N) ' , '(N) ' , '(N) ' , '(Nm)' , '(Nm)' , '(Nm)' /) + + + CALL CleanUp() ! deallocate local arrays + +CONTAINS + SUBROUTINE CleanUp() + + IF (UnSS > 0 ) CLOSE ( UnSS ) + + END SUBROUTINE CleanUp + +END SUBROUTINE SS_Exc_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +SUBROUTINE SS_Exc_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(SS_Exc_InputType), INTENT(INOUT) :: u !< System inputs + TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states + TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Place any last minute operations or calculations here: + ! Destroy the input data: + + CALL SS_Exc_DestroyInput( u, ErrStat, ErrMsg ) + + + ! Destroy the parameter data: + + CALL SS_Exc_DestroyParam( p, ErrStat, ErrMsg ) + + + ! Destroy the state data: + + CALL SS_Exc_DestroyContState( x, ErrStat, ErrMsg ) + CALL SS_Exc_DestroyDiscState( xd, ErrStat, ErrMsg ) + CALL SS_Exc_DestroyConstrState( z, ErrStat, ErrMsg ) + CALL SS_Exc_DestroyOtherState( OtherState, ErrStat, ErrMsg ) + + ! Destroy misc vars: + CALL SS_Exc_DestroyMisc( m, ErrStat, ErrMsg ) + + + ! Destroy the output data: + + CALL SS_Exc_DestroyOutput( y, ErrStat, ErrMsg ) + + + + +END SUBROUTINE SS_Exc_End +!---------------------------------------------------------------------------------------------------------------------------------- +!> Loose coupling routine for solving constraint states, integrating continuous states, and updating discrete states. +!! Continuous, constraint, and discrete states are updated to values at t + Interval. +SUBROUTINE SS_Exc_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval + TYPE(SS_Exc_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes + REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; + !! Output: Continuous states at t + Interval + TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; + !! Output: Constraint states at t + Interval + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at t; + !! Output: Other states at t + Interval + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER, PARAMETER :: IntegrationMethod = 3 + + + SELECT CASE ( IntegrationMethod ) + + CASE (1) ! RK4 + + CALL SS_Exc_RK4( t, n, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + + CASE (2) ! AB4 + + CALL SS_Exc_AB4( t, n, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + + CASE (3) ! ABM4 + + CALL SS_Exc_ABM4( t, n, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + + CASE DEFAULT !bjj: we already checked this at initialization, but for completeness: + + ErrStat = ErrID_Fatal + ErrMsg = ' Error in SS_Exc_UpdateStates: method must be 1 (RK4), 2 (AB4), or 3 (ABM4)' + RETURN + + END SELECT + + +END SUBROUTINE SS_Exc_UpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for computing outputs, used in both loose and tight coupling. +SUBROUTINE SS_Exc_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + TYPE(SS_Exc_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(SS_Exc_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None +! REAL(DbKi) :: test(6,1) + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Calc outputs of system, based on system states + ! [y] = [C]*[xr] + + y%y = matmul(p%C,x%x) + + ! Compute outputs here: + + y%WriteOutput(1) = REAL(Time,ReKi) + y%WriteOutput(2:7) = y%y + +END SUBROUTINE SS_Exc_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for computing derivatives of continuous states +SUBROUTINE SS_Exc_CalcContStateDeriv( Time, waveElev0, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + REAL(SiKi), INTENT(IN ) :: waveElev0 !< Wave elevation at origin at time: Time (m) + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(SS_Exc_OtherStateType), INTENT(IN ) :: OtherState !< Other states + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(SS_Exc_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at Time + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + CALL AllocAry( dxdt%x, p%N, 'SS_Exc_CalcContStateDeriv:dxdt%x', ErrStat, ErrMsg) + IF ( ErrStat >= AbortErrLev) RETURN + + ! Compute the first time derivatives of the continuous states here: + + !Calc dxdt of a state space system + ! [dxdt] = [A]*[xr]+B*[q] + + dxdt%x =matmul(p%A,x%x) + p%B * waveElev0 + +END SUBROUTINE SS_Exc_CalcContStateDeriv +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for updating discrete states +SUBROUTINE SS_Exc_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + TYPE(SS_Exc_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; + !! Output: Discrete states at Time + Interval + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + ! Update discrete states here: + + ! StateData%DiscState = + +END SUBROUTINE SS_Exc_UpdateDiscState +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for solving for the residual of the constraint state equations +SUBROUTINE SS_Exc_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + TYPE(SS_Exc_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) + TYPE(SS_Exc_OtherStateType), INTENT(IN ) :: OtherState !< Other/optimization states + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(SS_Exc_ConstraintStateType), INTENT( OUT) :: z_residual !< Residual of the constraint state equations using + !! the input values described above + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Solve for the constraint states here: + + z_residual%DummyConstrState = 0 + +END SUBROUTINE SS_Exc_CalcConstrStateResidual +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for numerically integrating ordinary differential equations: +!! +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! Define constants k1, k2, k3, and k4 as +!! k1 = dt * f(t , x_t ) +!! k2 = dt * f(t + dt/2 , x_t + k1/2 ) +!! k3 = dt * f(t + dt/2 , x_t + k2/2 ), and +!! k4 = dt * f(t + dt , x_t + k3 ). +!! Then the continuous states at t = t + dt are +!! x_(t+dt) = x_t + k1/6 + k2/3 + k3/3 + k4/6 + O(dt^5) +!! +!! For details, see: +!! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for +!! Runge-Kutta." �16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Cambridge University Press, pp. 704-716, 1992. +!! +SUBROUTINE SS_Exc_RK4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + + TYPE(SS_Exc_ContinuousStateType) :: xdot ! time derivatives of continuous states + TYPE(SS_Exc_ContinuousStateType) :: k1 ! RK4 constant; see above + TYPE(SS_Exc_ContinuousStateType) :: k2 ! RK4 constant; see above + TYPE(SS_Exc_ContinuousStateType) :: k3 ! RK4 constant; see above + TYPE(SS_Exc_ContinuousStateType) :: k4 ! RK4 constant; see above + TYPE(SS_Exc_ContinuousStateType) :: x_tmp ! Holds temporary modification to x + real(SiKi) :: waveElev0 ! interpolated value of the wave elevation at the origin + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + CALL SS_Exc_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL SS_Exc_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL SS_Exc_CopyContState( x, k3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL SS_Exc_CopyContState( x, k4, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL SS_Exc_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! find waveElev0 for time, t+p%Tc + + waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + ! find xdot at t + CALL SS_Exc_CalcContStateDeriv( t, waveElev0, p, x, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + k1%x = p%dt * xdot%x + x_tmp%x = x%x + 0.5 * k1%x + + ! find waveElev0 for time, t + p%Tc + dt/2 + waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT/2.0, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + + ! find xdot at t + dt/2 + CALL SS_Exc_CalcContStateDeriv( t + 0.5*p%dt, waveElev0, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + k2%x = p%dt * xdot%x + x_tmp%x = x%x + 0.5 * k2%x + + ! find xdot at t + dt/2 + CALL SS_Exc_CalcContStateDeriv( t + 0.5*p%dt, waveElev0, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + k3%x = p%dt * xdot%x + x_tmp%x = x%x + k3%x + + ! find waveElev0 for time, (t + p%Tc + dt) + waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + + + ! find xdot at t + dt + CALL SS_Exc_CalcContStateDeriv( t + p%dt, waveElev0, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + k4%x = p%dt * xdot%x + x%x = x%x + ( k1%x + 2. * k2%x + 2. * k3%x + k4%x ) / 6. + + ! clean up local variables: + CALL ExitThisRoutine( ) + +CONTAINS + !............................................................................................................................... + SUBROUTINE ExitThisRoutine() + ! This subroutine destroys all the local variables + !............................................................................................................................... + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + + CALL SS_Exc_DestroyContState( xdot, ErrStat3, ErrMsg3 ) + CALL SS_Exc_DestroyContState( k1, ErrStat3, ErrMsg3 ) + CALL SS_Exc_DestroyContState( k2, ErrStat3, ErrMsg3 ) + CALL SS_Exc_DestroyContState( k3, ErrStat3, ErrMsg3 ) + CALL SS_Exc_DestroyContState( k4, ErrStat3, ErrMsg3 ) + CALL SS_Exc_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) + + + END SUBROUTINE ExitThisRoutine + !............................................................................................................................... + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev + !............................................................................................................................... + + ! Passed arguments + INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) + CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + !............................................................................................................................ + ! Set error status/message; + !............................................................................................................................ + + IF ( ErrID /= ErrID_None ) THEN + + IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine + ErrMsg = TRIM(ErrMsg)//'SS_Exc_RK4:'//TRIM(Msg) + ErrStat = MAX(ErrStat,ErrID) + + !......................................................................................................................... + ! Clean up if we're going to return on error: close files, deallocate local arrays + !......................................................................................................................... + + IF ( ErrStat >= AbortErrLev ) CALL ExitThisRoutine( ) + + + END IF + + END SUBROUTINE CheckError + +END SUBROUTINE SS_Exc_RK4 +!----------------------------------------------------------------------------- +!! This subroutine implements the fourth-order Adams-Bashforth Method (RK4) for numerically integrating ordinary differential +!! equations: +!! +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! +!! x(t+dt) = x(t) + (dt / 24.) * ( 55.*f(t,x) - 59.*f(t-dt,x) + 37.*f(t-2.*dt,x) - 9.*f(t-3.*dt,x) ) +!! +!! See, e.g., +!! http://en.wikipedia.org/wiki/Linear_multistep_method +!! +!! or +!! +!! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. +!! +SUBROUTINE SS_Exc_AB4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + + real(SiKi) :: waveElev0 + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + if (OtherState%n .lt. n) then + + OtherState%n = n + + CALL SS_Exc_CopyContState( OtherState%xdot ( 3 ), OtherState%xdot ( 4 ), MESH_UPDATECOPY, ErrStat2, ErrMsg ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL SS_Exc_CopyContState( OtherState%xdot ( 2 ), OtherState%xdot ( 3 ), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL SS_Exc_CopyContState( OtherState%xdot ( 1 ), OtherState%xdot ( 2 ), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + + + elseif (OtherState%n .gt. n) then + + CALL CheckError( ErrID_Fatal, ' Backing up in time is not supported with a multistep method.') + RETURN + + endif + + ! find waveElev at t + Tc + waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + + CALL SS_Exc_CalcContStateDeriv( t, waveElev0, p, x, xd, z, OtherState, m, OtherState%xdot ( 1 ), ErrStat2, ErrMsg2 ) ! initializes OtherState%xdot ( 1 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + + if (n .le. 2) then + + CALL SS_Exc_RK4(t, n, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + else + + x%x = x%x + p%DT/24.0 * ( 55.*OtherState%xdot(1)%x - 59.*OtherState%xdot(2)%x & + + 37.*OtherState%xdot(3)%x - 9.*OtherState%xdot(4)%x ) + + + endif + + +CONTAINS + + !............................................................................................................................... + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev + !............................................................................................................................... + + ! Passed arguments + INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) + CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + !............................................................................................................................ + ! Set error status/message; + !............................................................................................................................ + + IF ( ErrID /= ErrID_None ) THEN + + IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine + ErrMsg = TRIM(ErrMsg)//'SS_Exc_AB4:'//TRIM(Msg) + ErrStat = MAX(ErrStat, ErrID) + + !......................................................................................................................... + ! Clean up if we're going to return on error: close files, deallocate local arrays + !......................................................................................................................... + + + END IF + + END SUBROUTINE CheckError + +END SUBROUTINE SS_Exc_AB4 +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Adams-Bashforth-Moulton Method (RK4) for numerically integrating ordinary +!! differential equations: +!! +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! +!! Adams-Bashforth Predictor: +!! x^p(t+dt) = x(t) + (dt / 24.) * ( 55.*f(t,x) - 59.*f(t-dt,x) + 37.*f(t-2.*dt,x) - 9.*f(t-3.*dt,x) ) +!! +!! Adams-Moulton Corrector: +!! x(t+dt) = x(t) + (dt / 24.) * ( 9.*f(t+dt,x^p) + 19.*f(t,x) - 5.*f(t-dt,x) + 1.*f(t-2.*dt,x) ) +!! +!! See, e.g., +!! http://en.wikipedia.org/wiki/Linear_multistep_method +!! +!! or +!! +!! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. +SUBROUTINE SS_Exc_ABM4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(SS_Exc_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + + TYPE(SS_Exc_ContinuousStateType) :: x_pred ! Continuous states at t + TYPE(SS_Exc_ContinuousStateType) :: xdot_pred ! Derivative of continuous states at t + real(SiKi) :: waveElev0 + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + CALL SS_Exc_CopyContState(x, x_pred, MESH_NEWCOPY, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + CALL SS_Exc_AB4( t, n, utimes, p, x_pred, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + if (n .gt. 2_IntKi) then + + waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + CALL SS_Exc_CalcContStateDeriv(t + p%dt, waveElev0, p, x_pred, xd, z, OtherState, m, xdot_pred, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + x%x = x%x + p%DT/24. * ( 9. * xdot_pred%x + 19. * OtherState%xdot(1)%x & + - 5. * OtherState%xdot(2)%x & + + 1. * OtherState%xdot(3)%x ) + + else + + x%x = x_pred%x + + endif + + + ! clean up local variables: + CALL ExitThisRoutine() + +CONTAINS + !............................................................................................................................... + SUBROUTINE ExitThisRoutine() + ! This subroutine destroys all the local variables + !............................................................................................................................... + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + + CALL SS_Exc_DestroyContState( xdot_pred, ErrStat3, ErrMsg3 ) + CALL SS_Exc_DestroyContState( x_pred, ErrStat3, ErrMsg3 ) + + END SUBROUTINE ExitThisRoutine + !............................................................................................................................... + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev + !............................................................................................................................... + + ! Passed arguments + INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) + CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + !............................................................................................................................ + ! Set error status/message; + !............................................................................................................................ + + IF ( ErrID /= ErrID_None ) THEN + + IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine + ErrMsg = TRIM(ErrMsg)//'SS_Exc_ABM4:'//TRIM(Msg) + ErrStat = MAX(ErrStat, ErrID) + + !......................................................................................................................... + ! Clean up if we're going to return on error: close files, deallocate local arrays + !......................................................................................................................... + IF ( ErrStat >= AbortErrLev ) CALL ExitThisRoutine( ) + + END IF + + END SUBROUTINE CheckError + +END SUBROUTINE SS_Exc_ABM4 +!---------------------------------------------------------------------------------------------------------------------------------- +END MODULE SS_Excitation +!********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt new file mode 100644 index 0000000000..1c98d4948b --- /dev/null +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -0,0 +1,71 @@ +################## Registry for SS Excitation ############### +# column 1: +# column 2: ModuleName/ModName or ^ to use the value from the previous line (ModName is nickname for ModuleName) +# column 3: Derived data type (without "ModName_" prefix) +# column 4: Derived data types's Field type +# column 5: Variable name +# column 6: Dimension of variable {:} for allocatable +# column 7: Variable's initial value (if set in the data type) +# column 8: I think this is a switch for mixed-language programming; it's mostly unused +# column 9: Description +# column 10: Units +################################################################################################################################### +# File last committed: $Date$ +# (File) Revision #: $Rev$ +# URL: $HeadURL$ +################################################################################################################################### + +typedef SS_Excitation/SS_Exc InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - +typedef ^ ^ ReKi WaveDir - - - "Wave direction" rad +typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - +typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin" m +typedef ^ ^ SiKi WaveTime {:} - - "Times where wave elevation is known" s + +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {7} - - "Header of the output" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {7} - - "Units of the output" - + +typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - + +typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - + +# Define constraint states here: +typedef ^ ConstraintStateType SiKi DummyConstrState - - - "" - + +# Define any data that are other states, including integer or logical states here: +typedef ^ OtherStateType IntKi n - - - "Current Time step" - +typedef ^ ^ SS_Exc_ContinuousStateType xdot {4} - - "Old Values of dxdt to used by the solver (multistep method)" - + + +# ..... Misc/Optimization variables................................................................................................. +# Define any data that are used only for efficiency purposes (these variables are not associated with time): +# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType INTEGER LastIndWave - 1 - "last used index in the WaveTime array" - + + +# ..... Parameters ......................... +# Define parameters here: +# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: + +typedef ^ ParameterType DbKi DT - - - "Time step" s +typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - +typedef ^ ^ IntKi spDOF {6} - - "States per DOF" - +typedef ^ ^ ReKi A {:}{:} - - "A matrix" - +typedef ^ ^ ReKi B {:} - - "B matrix" - +typedef ^ ^ ReKi C {:}{:} - - "C matrix" - +typedef ^ ^ INTEGER N - - - "Number of states" - +typedef ^ ^ DbKi Tc - - - "Time shift" s +typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin" m +typedef ^ ^ SiKi WaveTime {:} - - "Times where wave elevation is known" s + +# ..... Inputs ............................. +# Define inputs that are contained on the mesh here: +typedef ^ InputType ReKi DummyInput - - - "Remove this variable if you have input variables" - + + +# ..... Outputs ............................ +typedef ^ OutputType ReKi y {6} - - "Force/Moments" - +typedef ^ ^ ReKi WriteOutput {7} - - "output Data" "kN" - + + + + diff --git a/modules/hydrodyn/src/SS_Excitation_Driver.f90 b/modules/hydrodyn/src/SS_Excitation_Driver.f90 new file mode 100644 index 0000000000..e9170bf772 --- /dev/null +++ b/modules/hydrodyn/src/SS_Excitation_Driver.f90 @@ -0,0 +1,295 @@ +!********************************************************************************************************************************** +! SS_Excitation_Driver: This code tests the SS_Excitation module +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2018 National Renewable Energy Laboratory +! +! This file is part of SS_Excitation. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! +!********************************************************************************************************************************** +PROGRAM SS_Excitation_Driver + + USE NWTC_Library + USE SS_Excitation + USE SS_Excitation_Types + + IMPLICIT NONE + + ! Program variables + + REAL(DbKi) :: Time ! Variable for storing time, in seconds + REAL(DbKi) :: waveDT + !REAL(DbKi) :: Time2(145201,1) ! Variable for storing time, in seconds + !REAL(DbKi) :: tdq(145201,7) ! Variable for storing time and body velocities, in m/s or rad/s + !REAL(DbKi) :: dq(145201,6) ! Variable for storing body velocities, in m/s or rad/s + REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds + !INTEGER(B1Ki), ALLOCATABLE :: SaveAry(:) ! Array to store packed data structure + + TYPE(SS_Exc_InitInputType) :: InitInData ! Input data for initialization + TYPE(SS_Exc_InitOutputType) :: InitOutData ! Output data from initialization + + TYPE(SS_Exc_ContinuousStateType) :: x ! Continuous states + TYPE(SS_Exc_ContinuousStateType) :: x_new ! Continuous states at updated time + TYPE(SS_Exc_DiscreteStateType) :: xd ! Discrete states + TYPE(SS_Exc_DiscreteStateType) :: xd_new ! Discrete states at updated time + TYPE(SS_Exc_ConstraintStateType) :: z ! Constraint states + TYPE(SS_Exc_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) + TYPE(SS_Exc_OtherStateType) :: OtherState ! Other states + + TYPE(SS_Exc_ParameterType) :: p ! Parameters + TYPE(SS_Exc_InputType) :: u(1) ! System inputs + REAL(DbKi) :: InputTimes(1) ! System input times + TYPE(SS_Exc_OutputType) :: y ! System outputs + TYPE(SS_Exc_MiscVarType) :: m ! misc/optimization variables + + TYPE(SS_Exc_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states + + + + !Local Variables + INTEGER(IntKi) :: n ! Loop counter (for time step) + INTEGER(IntKi) :: I ! Loop counter (for time step) + INTEGER(IntKi) :: J ! Loop counter (for time step) + REAL(SiKi) :: ElevData + INTEGER(IntKi) :: UnWvEl ! Input file identifier + INTEGER(IntKi) :: Outputy ! Output file identifier + INTEGER(IntKi) :: ErrStat, ErrStat2 ! Status of error message + CHARACTER(1024) :: ErrMsg, ErrMsg2 ! Error message if ErrStat /= ErrID_None + INTEGER :: Sttus ! Error in reading input file + REAL(ReKi) :: Start ! CPU Time at start of the program + REAL(ReKi) :: Finnish ! CPU Time at the end of the program + REAL(ReKi) :: UsrTime + REAL(ReKi) :: Tratio + REAL(ReKi) :: Factor + CHARACTER(8) :: TimePer + INTEGER(4) :: EndTimes (8) ! An array holding the ending clock time of the simulation. + INTEGER(4) :: StrtTime (8) ! An array holding the starting clock time of the simulation. + REAL(ReKi) :: ClckTime + INTEGER :: len ! Number of input arguments + CHARACTER(1024) :: waveFile + + !............................................................................................................................... + ! Routines called in initialization + !............................................................................................................................... + + ErrStat = ErrID_None + ErrMsg = '' + + call NWTC_Init() + + ! Call Time + !call cpu_time(start) + !call DATE_AND_TIME ( Values=StrtTime ) + + + + ! Populate the InitInData data structure + + + ! This file name should be the WAMIT file name without extension! + InitInData%InputFile = 'C:\Dev\Envision\all-changes\Test_Models\5MW_Baseline\HydroData\barge' + InitInData%WaveDir = 0.0_ReKi + InitInData%NStepWave = 14520 + waveDT = 0.25 + allocate ( InitInData%WaveElev0(0:InitInData%NStepWave) , STAT=ErrStat2 ) + allocate ( InitInData%WaveTime (0:InitInData%NStepWave) , STAT=ErrStat2 ) + + ! Construct the wave times array + do i = 0,InitInData%NStepWave + InitInData%WaveTime(i) = waveDT*i + end do + + ! Need to read in the wave elevation data to pass in as initialization data + waveFile = 'C:\Dev\Envision\all-changes\Test_Models\5MW_ITIBarge_DLL_WTurb_WavesIrr\barge.Elev' + call GetNewUnit ( UnWvEl, ErrStat, ErrMsg ) + call OpenFInpFile ( UnWvEl, trim(waveFile), ErrStat, ErrMsg ) ! Open wave elevation file. + if ( ErrStat /= 0 ) then + ErrStat = ErrID_Fatal + ErrMsg = ' Could not open wave elevation file.' + print*, ( ErrMsg ) + end if + + call ReadCom ( UnWvEl, trim(waveFile), 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Excitation_Driver') + + do i = 0,InitInData%NStepWave - 1 + call ReadVar( UnWvEl,trim(waveFile), InitInData%WaveElev0(i), 'InitInData%WaveElev0(i)', 'Wave elevation',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Excitation_Driver') + end do + + close ( UnWvEl ) !Close dq input file + + ! Now set the last element of the Wave elevation array to match the initial elevation for wrapping + InitInData%WaveElev0(InitInData%NStepWave) = InitInData%WaveElev0(0) + + + + ! Set the driver's request for time interval here: This should be the Rdtn DT defined in the hydrodyn input file + TimeInterval = 0.005 + + CALL SS_Exc_Init( InitInData, u(1), p, x, xd, z, OtherState, y, m, TimeInterval, InitOutData, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + + + ! Initialize output file + call GetNewUnit ( Outputy, ErrStat, ErrMsg ) + CALL OpenFOutFile ( Outputy, (TRIM(InitInData%InputFile)//'.out'), ErrStat, ErrMsg) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error opening output file.' + CALL WrScr( ErrMsg ) + END IF + + WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputHdr + IF ( Sttus /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error writing output file.' + CALL WrScr( ErrMsg ) + ENDIF + + WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputUnt + IF ( Sttus /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error writing output file.' + CALL WrScr( ErrMsg ) + ENDIF + + !............................................................................................................................... + ! Routines called in loose coupling -- the glue code may implement this in various ways + !............................................................................................................................... + + CALL WrScr( 'Runnig SS_Excitation in Loose Coupling using a Adams-Bashforth-Moulton Method' ) + + CALL SS_Exc_CopyDiscState( xd, xd_new, MESH_NEWCOPY, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + + CALL SS_Exc_CopyContState( x, x_new, MESH_NEWCOPY, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + ! + + DO n = 0,InitInData%NStepWave-1 + + Time = n*TimeInterval + InputTimes(1) = Time + + ! Get state variables at next step: constraint states (z) at step n, continuous and discrete states at step n + 1 + CALL SS_Exc_UpdateStates( Time, n, u, InputTimes, p, x_new, xd_new, z, OtherState, m, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + !print*, x%x + ! Calculate outputs at n + + CALL SS_Exc_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + ! Update x and xd with continuous and discrete states at n + 1 + ! Note that the constraint state guess at n+1 is the value of the constraint state at n (so it doesn't need updating here) + + CALL SS_Exc_CopyContState( x_new, x, MESH_UPDATECOPY, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + CALL SS_Exc_CopyDiscState( xd_new, xd, MESH_UPDATECOPY, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + !Write Output to file + WRITE(Outputy,'(7(e16.6))',IOSTAT=Sttus) y%WriteOutput + IF ( Sttus /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error writing output file.' + CALL WrScr( ErrMsg ) + print*, ErrMsg + ENDIF + END DO + + + CALL SS_Exc_DestroyDiscState( xd_new, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + CALL SS_Exc_DestroyContState( x_new, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + + + !............................................................................................................................... + ! Routine to terminate program execution + !............................................................................................................................... + CALL SS_Exc_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( ErrMsg ) + END IF + + + !!!! GREG: This is also to ouput values (dont need it) + !CALL DATE_AND_TIME ( VALUES=EndTimes ) + !CALL cpu_time(finnish) + ! + !ClckTime = 0.001*( EndTimes(8) - StrtTime(8) ) + ( EndTimes(7) - StrtTime(7) ) + 60.0*( EndTimes(6) - StrtTime(6) ) & + ! + 3600.0*( EndTimes(5) - StrtTime(5) ) + 86400.0*( EndTimes(3) - StrtTime(3) ) + ! + !UsrTime = finnish-start + ! + !IF ( UsrTime /= 0.0 ) THEN + ! + !TRatio = Time / UsrTime + ! + !IF ( UsrTime > 86400.0 ) THEN + ! Factor = 1.0/86400.0 + ! TimePer = ' days' + !ELSEIF ( UsrTime > 3600.0 ) THEN + ! Factor = 1.0/3600.0 + ! TimePer = ' hours' + !ELSEIF ( UsrTime > 60.0 ) THEN + ! Factor = 1.0/60.0 + ! TimePer = ' minutes' + !ELSE + ! Factor = 1.0 + ! TimePer = ' seconds' + !ENDIF + ! + !CALL WrScr ( ' Total Real Time: '//TRIM( Flt2LStr( Factor*ClckTime ) )//TRIM( TimePer ) ) + !CALL WrScr ( ' Total CPU Time: '//TRIM( Flt2LStr( Factor*UsrTime ) )//TRIM( TimePer ) ) + !CALL WrScr ( ' Simulated Time: '//TRIM( Flt2LStr( Factor*REAL( Time ) ) )//TRIM( TimePer ) ) + !CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Flt2LStr( TRatio ) ) ) + ! + !ENDIF + + + !!Write Output to file + ! WRITE(Outputy,'(1(e16.6))',IOSTAT=Sttus) TRatio + ! ! Ending routines + + CLOSE( Outputy ) + + + +END PROGRAM SS_Excitation_Driver + diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 new file mode 100644 index 0000000000..10966b9c6e --- /dev/null +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -0,0 +1,2331 @@ +!STARTOFREGISTRYGENERATEDFILE 'SS_Excitation_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! SS_Excitation_Types +!................................................................................................................................. +! This file is part of SS_Excitation. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in SS_Excitation. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE SS_Excitation_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= SS_Exc_InitInputType ======= + TYPE, PUBLIC :: SS_Exc_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + REAL(ReKi) :: WaveDir !< Wave direction [rad] + INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin [m] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Times where wave elevation is known [s] + END TYPE SS_Exc_InitInputType +! ======================= +! ========= SS_Exc_InitOutputType ======= + TYPE, PUBLIC :: SS_Exc_InitOutputType + CHARACTER(ChanLen) , DIMENSION(1:7) :: WriteOutputHdr !< Header of the output [-] + CHARACTER(ChanLen) , DIMENSION(1:7) :: WriteOutputUnt !< Units of the output [-] + END TYPE SS_Exc_InitOutputType +! ======================= +! ========= SS_Exc_ContinuousStateType ======= + TYPE, PUBLIC :: SS_Exc_ContinuousStateType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] + END TYPE SS_Exc_ContinuousStateType +! ======================= +! ========= SS_Exc_DiscreteStateType ======= + TYPE, PUBLIC :: SS_Exc_DiscreteStateType + REAL(SiKi) :: DummyDiscState !< [-] + END TYPE SS_Exc_DiscreteStateType +! ======================= +! ========= SS_Exc_ConstraintStateType ======= + TYPE, PUBLIC :: SS_Exc_ConstraintStateType + REAL(SiKi) :: DummyConstrState !< [-] + END TYPE SS_Exc_ConstraintStateType +! ======================= +! ========= SS_Exc_OtherStateType ======= + TYPE, PUBLIC :: SS_Exc_OtherStateType + INTEGER(IntKi) :: n !< Current Time step [-] + TYPE(SS_Exc_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] + END TYPE SS_Exc_OtherStateType +! ======================= +! ========= SS_Exc_MiscVarType ======= + TYPE, PUBLIC :: SS_Exc_MiscVarType + INTEGER(IntKi) :: LastIndWave = 1 !< last used index in the WaveTime array [-] + END TYPE SS_Exc_MiscVarType +! ======================= +! ========= SS_Exc_ParameterType ======= + TYPE, PUBLIC :: SS_Exc_ParameterType + REAL(DbKi) :: DT !< Time step [s] + INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + INTEGER(IntKi) , DIMENSION(1:6) :: spDOF !< States per DOF [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: B !< B matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] + INTEGER(IntKi) :: N !< Number of states [-] + REAL(DbKi) :: Tc !< Time shift [s] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin [m] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Times where wave elevation is known [s] + END TYPE SS_Exc_ParameterType +! ======================= +! ========= SS_Exc_InputType ======= + TYPE, PUBLIC :: SS_Exc_InputType + REAL(ReKi) :: DummyInput !< Remove this variable if you have input variables [-] + END TYPE SS_Exc_InputType +! ======================= +! ========= SS_Exc_OutputType ======= + TYPE, PUBLIC :: SS_Exc_OutputType + REAL(ReKi) , DIMENSION(1:6) :: y !< Force/Moments [-] + REAL(ReKi) , DIMENSION(1:7) :: WriteOutput !< output Data [kN] + END TYPE SS_Exc_OutputType +! ======================= +CONTAINS + SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%NStepWave = SrcInitInputData%NStepWave +IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElev0,1) + i1_u = UBOUND(SrcInitInputData%WaveElev0,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN + ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN + i1_l = LBOUND(SrcInitInputData%WaveTime,1) + i1_u = UBOUND(SrcInitInputData%WaveTime,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN + ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveTime = SrcInitInputData%WaveTime +ENDIF + END SUBROUTINE SS_Exc_CopyInitInput + + SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitInputData%WaveElev0)) THEN + DEALLOCATE(InitInputData%WaveElev0) +ENDIF +IF (ALLOCATED(InitInputData%WaveTime)) THEN + DEALLOCATE(InitInputData%WaveTime) +ENDIF + END SUBROUTINE SS_Exc_DestroyInitInput + + SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile + Re_BufSz = Re_BufSz + 1 ! WaveDir + Int_BufSz = Int_BufSz + 1 ! NStepWave + Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no + IF ( ALLOCATED(InData%WaveElev0) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SS_Exc_PackInitInput + + SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SS_Exc_UnPackInitInput + + SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + END SUBROUTINE SS_Exc_CopyInitOutput + + SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SS_Exc_DestroyInitOutput + + SUBROUTINE SS_Exc_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%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 + 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 SUBROUTINE SS_Exc_PackInitOutput + + SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%WriteOutputHdr,1) + i1_u = UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + i1_l = LBOUND(OutData%WriteOutputUnt,1) + i1_u = UBOUND(OutData%WriteOutputUnt,1) + 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 SUBROUTINE SS_Exc_UnPackInitOutput + + SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcContStateData%x)) THEN + i1_l = LBOUND(SrcContStateData%x,1) + i1_u = UBOUND(SrcContStateData%x,1) + IF (.NOT. ALLOCATED(DstContStateData%x)) THEN + ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%x = SrcContStateData%x +ENDIF + END SUBROUTINE SS_Exc_CopyContState + + SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ContStateData%x)) THEN + DEALLOCATE(ContStateData%x) +ENDIF + END SUBROUTINE SS_Exc_DestroyContState + + SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x allocated yes/no + IF ( ALLOCATED(InData%x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%x) ! x + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE SS_Exc_PackContState + + SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) + ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE SS_Exc_UnPackContState + + SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE SS_Exc_CopyDiscState + + SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyDiscState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SS_Exc_DestroyDiscState + + SUBROUTINE SS_Exc_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyDiscState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SS_Exc_PackDiscState + + SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SS_Exc_UnPackDiscState + + SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE SS_Exc_CopyConstrState + + SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyConstrState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SS_Exc_DestroyConstrState + + SUBROUTINE SS_Exc_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SS_Exc_PackConstrState + + SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SS_Exc_UnPackConstrState + + SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%n = SrcOtherStateData%n + DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) + CALL SS_Exc_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + END SUBROUTINE SS_Exc_CopyOtherState + + SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOtherState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) + CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat, ErrMsg ) +ENDDO + END SUBROUTINE SS_Exc_DestroyOtherState + + SUBROUTINE SS_Exc_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! n + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype + CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xdot + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xdot + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xdot + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END SUBROUTINE SS_Exc_PackOtherState + + SUBROUTINE SS_Exc_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%xdot,1) + i1_u = UBOUND(OutData%xdot,1) + DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END SUBROUTINE SS_Exc_UnPackOtherState + + SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + END SUBROUTINE SS_Exc_CopyMisc + + SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SS_Exc_DestroyMisc + + SUBROUTINE SS_Exc_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! LastIndWave + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SS_Exc_PackMisc + + SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SS_Exc_UnPackMisc + + SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_ParameterType), INTENT(IN) :: SrcParamData + TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%spDOF = SrcParamData%spDOF +IF (ALLOCATED(SrcParamData%A)) THEN + i1_l = LBOUND(SrcParamData%A,1) + i1_u = UBOUND(SrcParamData%A,1) + i2_l = LBOUND(SrcParamData%A,2) + i2_u = UBOUND(SrcParamData%A,2) + IF (.NOT. ALLOCATED(DstParamData%A)) THEN + ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%A = SrcParamData%A +ENDIF +IF (ALLOCATED(SrcParamData%B)) THEN + i1_l = LBOUND(SrcParamData%B,1) + i1_u = UBOUND(SrcParamData%B,1) + IF (.NOT. ALLOCATED(DstParamData%B)) THEN + ALLOCATE(DstParamData%B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%B = SrcParamData%B +ENDIF +IF (ALLOCATED(SrcParamData%C)) THEN + i1_l = LBOUND(SrcParamData%C,1) + i1_u = UBOUND(SrcParamData%C,1) + i2_l = LBOUND(SrcParamData%C,2) + i2_u = UBOUND(SrcParamData%C,2) + IF (.NOT. ALLOCATED(DstParamData%C)) THEN + ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C = SrcParamData%C +ENDIF + DstParamData%N = SrcParamData%N + DstParamData%Tc = SrcParamData%Tc +IF (ALLOCATED(SrcParamData%WaveElev0)) THEN + i1_l = LBOUND(SrcParamData%WaveElev0,1) + i1_u = UBOUND(SrcParamData%WaveElev0,1) + IF (.NOT. ALLOCATED(DstParamData%WaveElev0)) THEN + ALLOCATE(DstParamData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%WaveElev0 = SrcParamData%WaveElev0 +ENDIF +IF (ALLOCATED(SrcParamData%WaveTime)) THEN + i1_l = LBOUND(SrcParamData%WaveTime,1) + i1_u = UBOUND(SrcParamData%WaveTime,1) + IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN + ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%WaveTime = SrcParamData%WaveTime +ENDIF + END SUBROUTINE SS_Exc_CopyParam + + SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyParam' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ParamData%A)) THEN + DEALLOCATE(ParamData%A) +ENDIF +IF (ALLOCATED(ParamData%B)) THEN + DEALLOCATE(ParamData%B) +ENDIF +IF (ALLOCATED(ParamData%C)) THEN + DEALLOCATE(ParamData%C) +ENDIF +IF (ALLOCATED(ParamData%WaveElev0)) THEN + DEALLOCATE(ParamData%WaveElev0) +ENDIF +IF (ALLOCATED(ParamData%WaveTime)) THEN + DEALLOCATE(ParamData%WaveTime) +ENDIF + END SUBROUTINE SS_Exc_DestroyParam + + SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT + Int_BufSz = Int_BufSz + 1 ! NStepWave + Int_BufSz = Int_BufSz + SIZE(InData%spDOF) ! spDOF + Int_BufSz = Int_BufSz + 1 ! A allocated yes/no + IF ( ALLOCATED(InData%A) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%A) ! A + END IF + Int_BufSz = Int_BufSz + 1 ! B allocated yes/no + IF ( ALLOCATED(InData%B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! B upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%B) ! B + END IF + Int_BufSz = Int_BufSz + 1 ! C allocated yes/no + IF ( ALLOCATED(InData%C) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C) ! C + END IF + Int_BufSz = Int_BufSz + 1 ! N + Db_BufSz = Db_BufSz + 1 ! Tc + Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no + IF ( ALLOCATED(InData%WaveElev0) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%spDOF,1), UBOUND(InData%spDOF,1) + IntKiBuf(Int_Xferred) = InData%spDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%A) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tc + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SS_Exc_PackParam + + SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%spDOF,1) + i1_u = UBOUND(OutData%spDOF,1) + DO i1 = LBOUND(OutData%spDOF,1), UBOUND(OutData%spDOF,1) + OutData%spDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) + ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) + ALLOCATE(OutData%B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) + ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tc = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SS_Exc_UnPackParam + + SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_InputType), INTENT(IN) :: SrcInputData + TYPE(SS_Exc_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputData%DummyInput = SrcInputData%DummyInput + END SUBROUTINE SS_Exc_CopyInput + + SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(SS_Exc_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SS_Exc_DestroyInput + + SUBROUTINE SS_Exc_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyInput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SS_Exc_PackInput + + SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyInput = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SS_Exc_UnPackInput + + SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SS_Exc_OutputType), INTENT(IN) :: SrcOutputData + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOutputData%y = SrcOutputData%y + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + END SUBROUTINE SS_Exc_CopyOutput + + SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SS_Exc_DestroyOutput + + SUBROUTINE SS_Exc_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SS_Exc_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%y) ! y + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + ReKiBuf(Re_Xferred) = InData%y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE SS_Exc_PackOutput + + SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%y,1) + i1_u = UBOUND(OutData%y,1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%WriteOutput,1) + i1_u = UBOUND(OutData%WriteOutput,1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE SS_Exc_UnPackOutput + + + SUBROUTINE SS_Exc_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(SS_Exc_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL SS_Exc_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL SS_Exc_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE SS_Exc_Input_ExtrapInterp + + + SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor + END SUBROUTINE SS_Exc_Input_ExtrapInterp1 + + + SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out + END SUBROUTINE SS_Exc_Input_ExtrapInterp2 + + + SUBROUTINE SS_Exc_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(SS_Exc_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL SS_Exc_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL SS_Exc_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE SS_Exc_Output_ExtrapInterp + + + SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = -(y1%y(i1) - y2%y(i1)) + y_out%y(i1) = y1%y(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO + END SUBROUTINE SS_Exc_Output_ExtrapInterp1 + + + SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor + y_out%y(i1) = y1%y(i1) + b + c * t_out + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO + END SUBROUTINE SS_Exc_Output_ExtrapInterp2 + +END MODULE SS_Excitation_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation.f90 b/modules/hydrodyn/src/SS_Radiation.f90 index b95b5eafa8..62a9b873d1 100644 --- a/modules/hydrodyn/src/SS_Radiation.f90 +++ b/modules/hydrodyn/src/SS_Radiation.f90 @@ -82,7 +82,6 @@ SUBROUTINE SS_Rad_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini INTEGER :: I ! Generic index ! INTEGER :: J ! Generic index INTEGER :: xx (1,6) ! Active DOF's on the input file .ss - INTEGER(IntKi) :: spdof (1,6) ! States per dof INTEGER :: DOFs ! Number of DOFS INTEGER :: N ! Number of states INTEGER :: Nlines ! Number of lines in the input file, used to determine N @@ -91,7 +90,7 @@ SUBROUTINE SS_Rad_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !CHARACTER :: Line ! Temp line of file integer :: ErrStat2 - character(1024) :: ErrMsg2 + character(ErrMsgLen) :: ErrMsg2 ! Initialize ErrStat ErrStat = ErrID_None @@ -118,7 +117,7 @@ SUBROUTINE SS_Rad_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ss', N, 'N', 'Number of Dofs',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') - CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ss', spdof(1,:), 6, 'spdof', 'spdof vector containing the number of states per dofs',ErrStat2, ErrMsg2) ! Reads in the forth line, containing the state per dofs vector + CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ss', p%spdof, 6, 'spdof', 'spdof vector containing the number of states per dofs',ErrStat2, ErrMsg2) ! Reads in the forth line, containing the state per dofs vector CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() @@ -142,7 +141,7 @@ SUBROUTINE SS_Rad_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SetErrStat(ErrID_Severe,'Error in the input file .ss: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,'SS_Rad_Init') END IF - IF ( N /= SUM(spdof)) THEN + IF ( N /= SUM(p%spdof)) THEN CALL SetErrStat(ErrID_Severe,'Error in the input file .ss: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,'SS_Rad_Init') END IF @@ -204,7 +203,7 @@ SUBROUTINE SS_Rad_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini p%N=0 DO I=1,6 !For each state IF ( InitInp%DOFs (1,I) == 1) THEN ! True when the current DOF is active in FAST - p%N = p%N + spdof(1,I) !Add the correspondent number of states to the vector + p%N = p%N + p%spdof(I) !Add the correspondent number of states to the vector END IF END DO @@ -240,13 +239,13 @@ SUBROUTINE SS_Rad_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini N=1 !Use as number of active states introduced DO I=1,6 !For each dof... - IF ( InitInp%DOFs (1,I) == 1 .AND. sum(spdof(1,1:I))0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE SS_Rad_PackContState @@ -559,12 +537,6 @@ SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -592,15 +564,10 @@ SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE SS_Rad_UnPackContState @@ -695,8 +662,8 @@ SUBROUTINE SS_Rad_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackDiscState SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -712,12 +679,6 @@ SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackDiscState' @@ -731,8 +692,8 @@ SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackDiscState SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -826,8 +787,8 @@ SUBROUTINE SS_Rad_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackConstrState SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -843,12 +804,6 @@ SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackConstrState' @@ -862,8 +817,8 @@ SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackConstrState SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -986,8 +941,8 @@ SUBROUTINE SS_Rad_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1033,12 +988,6 @@ SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1053,8 +1002,8 @@ SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -1192,8 +1141,8 @@ SUBROUTINE SS_Rad_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackMisc SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1209,12 +1158,6 @@ SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackMisc' @@ -1228,8 +1171,8 @@ SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackMisc SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1292,6 +1235,7 @@ SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C = SrcParamData%C ENDIF DstParamData%N = SrcParamData%N + DstParamData%spdof = SrcParamData%spdof END SUBROUTINE SS_Rad_CopyParam SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -1366,6 +1310,7 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + SIZE(InData%C) ! C END IF Int_BufSz = Int_BufSz + 1 ! N + Int_BufSz = Int_BufSz + SIZE(InData%spdof) ! spdof IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1393,8 +1338,8 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%A) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1408,8 +1353,12 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1424,8 +1373,12 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1440,11 +1393,19 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%spdof,1), UBOUND(InData%spdof,1) + IntKiBuf(Int_Xferred) = InData%spdof(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackParam SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1460,12 +1421,6 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1481,8 +1436,8 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1499,15 +1454,12 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -1525,15 +1477,12 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated Int_Xferred = Int_Xferred + 1 @@ -1551,18 +1500,21 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%spdof,1) + i1_u = UBOUND(OutData%spdof,1) + DO i1 = LBOUND(OutData%spdof,1), UBOUND(OutData%spdof,1) + OutData%spdof(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackParam SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1657,8 +1609,10 @@ SUBROUTINE SS_Rad_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dq))-1 ) = PACK(InData%dq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dq) + DO i1 = LBOUND(InData%dq,1), UBOUND(InData%dq,1) + ReKiBuf(Re_Xferred) = InData%dq(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackInput SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1674,12 +1628,6 @@ SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1696,15 +1644,10 @@ SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%dq,1) i1_u = UBOUND(OutData%dq,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%dq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dq))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dq) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dq,1), UBOUND(OutData%dq,1) + OutData%dq(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackInput SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1801,10 +1744,14 @@ SUBROUTINE SS_Rad_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%y) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + ReKiBuf(Re_Xferred) = InData%y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackOutput SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1820,12 +1767,6 @@ SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1842,26 +1783,16 @@ SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Xferred = 1 i1_l = LBOUND(OutData%y,1) i1_u = UBOUND(OutData%y,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%WriteOutput,1) i1_u = UBOUND(OutData%WriteOutput,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackOutput @@ -1939,12 +1870,12 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1957,12 +1888,12 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%dq,1))) - ALLOCATE(c1(SIZE(u_out%dq,1))) - b1 = -(u1%dq - u2%dq)/t(2) - u_out%dq = u1%dq + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) + b = -(u1%dq(i1) - u2%dq(i1)) + u_out%dq(i1) = u1%dq(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Rad_Input_ExtrapInterp1 @@ -1992,13 +1923,14 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2017,13 +1949,13 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%dq,1))) - ALLOCATE(c1(SIZE(u_out%dq,1))) - b1 = (t(3)**2*(u1%dq - u2%dq) + t(2)**2*(-u1%dq + u3%dq))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%dq + t(3)*u2%dq - t(2)*u3%dq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%dq = u1%dq + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) + b = (t(3)**2*(u1%dq(i1) - u2%dq(i1)) + t(2)**2*(-u1%dq(i1) + u3%dq(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%dq(i1) + t(3)*u2%dq(i1) - t(2)*u3%dq(i1) ) * scaleFactor + u_out%dq(i1) = u1%dq(i1) + b + c * t_out + END DO END SUBROUTINE SS_Rad_Input_ExtrapInterp2 @@ -2101,12 +2033,12 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2119,18 +2051,16 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = -(y1%y - y2%y)/t(2) - y_out%y = y1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = -(y1%y(i1) - y2%y(i1)) + y_out%y(i1) = y1%y(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Rad_Output_ExtrapInterp1 @@ -2160,13 +2090,14 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2185,20 +2116,18 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = (t(3)**2*(y1%y - y2%y) + t(2)**2*(-y1%y + y3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%y + t(3)*y2%y - t(2)*y3%y ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%y = y1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor + y_out%y(i1) = y1%y(i1) + b + c * t_out + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END SUBROUTINE SS_Rad_Output_ExtrapInterp2 END MODULE SS_Radiation_Types diff --git a/modules/hydrodyn/src/UserWaves.f90 b/modules/hydrodyn/src/UserWaves.f90 index 495fb3fe28..a979b5df93 100644 --- a/modules/hydrodyn/src/UserWaves.f90 +++ b/modules/hydrodyn/src/UserWaves.f90 @@ -64,7 +64,7 @@ SUBROUTINE WaveElev_ReadFile ( InitInp, WaveElevData, ErrStat, ErrMsg ) INTEGER(IntKi) :: NumHeaderLines !< Number of header lines in the file. INTEGER(IntKi) :: WaveElevUnit !< Unit number for the ElevFileName INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing - CHARACTER(1024) :: ErrMsgTmp !< Temporary error message for processing + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing CHARACTER(*), PARAMETER :: RoutineName = 'WaveElev_ReadFile' @@ -526,7 +526,7 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Temporary error handling variables INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing - CHARACTER(1024) :: ErrMsgTmp !< Temporary error message for processing + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing CHARACTER(*), PARAMETER :: RoutineName = 'UserWaveElevations_Init' ! Data verification: WaveDT in the HD file and in the .Elev file may be slightly different. We will allow @@ -690,7 +690,7 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Temporary error handling variables INTEGER(IntKi) :: ErrStatTmp ! Temporarary error status for procesing - CHARACTER(1024) :: ErrMsgTmp ! Temporary error message for processing + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for processing LOGICAL :: isNumeric CHARACTER(*), PARAMETER :: RoutineName = 'UserWaves_Init' CHARACTER(5) :: extension(7) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 6cf0a51f79..d807b4a84e 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -29,6 +29,7 @@ MODULE WAMIT ! USE Waves_Types USE Conv_Radiation USE SS_Radiation + USE SS_Excitation USE NWTC_FFTPACK IMPLICIT NONE @@ -62,7 +63,7 @@ MODULE WAMIT SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(WAMIT_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(WAMIT_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine. NOTE: we need INOUT because we may be moving the allocation of SS_Excitation data TYPE(WAMIT_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(WAMIT_ParameterType), INTENT( OUT) :: p !< Parameters TYPE(WAMIT_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states @@ -92,10 +93,12 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init !TYPE(Conv_Rdtn_InitOutputType) :: Conv_RdtnInitOutData TYPE(SS_Rad_InitInputType) :: SS_Rdtn_InitInp ! Local version of the intialization data for the radiation module TYPE(SS_Rad_InitOutputType) :: SS_Rdtn_InitOut ! Initialization Outputs from the SS_Rdtn module initialization + TYPE(SS_Exc_InitInputType) :: SS_Exctn_InitInp ! Local version of the intialization data for the SS wave excitation module + TYPE(SS_Exc_InitOutputType) :: SS_Exctn_InitOut ! Initialization Outputs from the SS wave excitation module initialization ! Local Variables - + REAL(DbKi) :: Interval_Sub ! Local timestep for the SS_Rad and SS_Exc modules, based on RdtnDT COMPLEX(SiKi), ALLOCATABLE :: HdroExctn (:,:,:) ! Frequency- and direction-dependent complex hydrodynamic wave excitation force per unit wave amplitude vector (kg/s^2, kg-m/s^2) COMPLEX(SiKi), ALLOCATABLE :: WaveExctnC(:,:) ! Discrete Fourier transform of the instantaneous value of the total excitation force on the support platfrom from incident waves (N, N-m) REAL(ReKi) :: DffrctDim (6) ! Matrix used to redimensionalize WAMIT hydrodynamic wave excitation force output (kg/s^2, kg-m/s^2 ) @@ -147,7 +150,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using ! Error handling - CHARACTER(1024) :: ErrMsg2 ! Temporary error message for calls + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary error message for calls INTEGER(IntKi) :: ErrStat2 ! Temporary error status for calls @@ -179,7 +182,13 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%RhoXg = InitInp%RhoXg p%NStepWave = InitInp%NStepWave p%NumOuts = InitInp%NumOuts + p%ExctnMod = InitInp%ExctnMod + ! For now, we are forcing WAMIT to use the glue-code time-step. If the Convolution-based radiation module was requesting a different timestep (RdtnDT) + ! Then HydroDyn will have already thrown an error. + + p%DT = Interval + !IF ( InitInp%HasWAMIT ) THEN ! p%NumOuts = InitInp%NumOuts !ELSE @@ -716,7 +725,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END DO ! End loop through all rows in the file - +if (p%ExctnMod == 1 ) then REWIND (UNIT=UnW3) ! REWIND the file so we can read it in a third time. (This is getting ridiculous!) @@ -792,6 +801,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CLOSE ( UnW3 ) ! Close file. +end if ! For some reason, WAMIT computes the zero- and infinite- frequency limits for ! only the added mass. Based on hydrodynamic theory, the damping is zero at @@ -853,165 +863,218 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END DO ! J - All rows of HdroAdMsI - - - + if ( ( p%ExctnMod == 0 ) ) then + + ! no need to allocate the p%WaveExctn array because it won't be used + + else ! Initialize the variables associated with the incident wave: - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? - - CASE ( 0 ) ! None=still water. - + SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? + CASE ( 0 ) + if ( p%ExctnMod == 1 ) then + ! Initialize everything to zero: + ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN + END IF - ! Initialize everything to zero: - - ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF - - p%WaveExctn = 0.0 + p%WaveExctn = 0.0 - CASE ( 1, 2, 3, 4, 5, 10 ) ! Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, white-noise wave, or user-defined spectrum (irregular) wave. - - - - ! Abort if we have chosen a wave heading direction that is outside the range - ! of directions where the complex wave excitation force per unit wave - ! amplitude vector has been defined, else interpolate to find the complex - ! wave excitation force per unit wave amplitude vector at the chosen wave - ! heading direction: - ! NOTE: we may end up inadvertantly aborting if the wave direction crosses - ! the -Pi / Pi boundary (-180/180 degrees). - - IF ( ( InitInp%WaveDirMin < HdroWvDir(1) ) .OR. ( InitInp%WaveDirMax > HdroWvDir(NInpWvDir) ) ) THEN - ErrMsg2 = 'All Wave directions must be within the wave heading angle range available in "' & - //TRIM(InitInp%WAMITFile)//'.3" (inclusive).' - CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF - + else if ( p%ExctnMod == 2 ) then + Interval_Sub = InitInp%Conv_Rdtn%RdtnDT + SS_Exctn_InitInp%InputFile = InitInp%WAMITFile + SS_Exctn_InitInp%WaveDir = InitInp%WaveDir + SS_Exctn_InitInp%NStepWave = p%NStepWave + + ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module + IF (ALLOCATED(InitInp%WaveElev0)) CALL MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) + + ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation + ALLOCATE ( SS_Exctn_InitInp%WaveTime (0:InitInp%NStepWave) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the SS_Exctn_InitInp%WaveTime array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN + END IF + SS_Exctn_InitInp%WaveTime = InitInp%WaveTime + + call SS_Exc_Init(SS_Exctn_InitInp, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, & + m%SS_Exctn_y, m%SS_Exctn, Interval_Sub, SS_Exctn_InitOut, ErrStat2, ErrMsg2) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + end if + CASE ( 1, 2, 3, 4, 5, 10 ) ! Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, white-noise wave, or user-defined spectrum (irregular) wave. + + ! Abort if we have chosen a wave heading direction that is outside the range + ! of directions where the complex wave excitation force per unit wave + ! amplitude vector has been defined, else interpolate to find the complex + ! wave excitation force per unit wave amplitude vector at the chosen wave + ! heading direction: + ! NOTE: we may end up inadvertantly aborting if the wave direction crosses + ! the -Pi / Pi boundary (-180/180 degrees). + + IF ( ( InitInp%WaveDirMin < HdroWvDir(1) ) .OR. ( InitInp%WaveDirMax > HdroWvDir(NInpWvDir) ) ) THEN + ErrMsg2 = 'All Wave directions must be within the wave heading angle range available in "' & + //TRIM(InitInp%WAMITFile)//'.3" (inclusive).' + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN + END IF - ! ALLOCATE the arrays: + if ( p%ExctnMod == 1 ) then + + ! Calculate the WaveExctn data from WAMIT data if ExctnMod = 1 + + ! ALLOCATE the arrays: - ALLOCATE ( WaveExctnC(0:InitInp%NStepWave2 ,6) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF + ALLOCATE ( WaveExctnC(0:InitInp%NStepWave2 ,6) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN + END IF - ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF + ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN + END IF - ! Compute the positive-frequency components (including zero) of the discrete - ! Fourier transform of the wave excitation force: + ! Compute the positive-frequency components (including zero) of the discrete + ! Fourier transform of the wave excitation force: - DO I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + DO I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - ! Compute the frequency of this component: + ! Compute the frequency of this component: - Omega = I*InitInp%WaveDOmega + Omega = I*InitInp%WaveDOmega - ! Compute the discrete Fourier transform of the instantaneous value of the - ! total excitation force on the support platfrom from incident waves: + ! Compute the discrete Fourier transform of the instantaneous value of the + ! total excitation force on the support platfrom from incident waves: - DO J = 1,6 ! Loop through all wave excitation forces and moments - TmpCoord(1) = Omega - TmpCoord(2) = InitInp%WaveDirArr(I) - CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I)) - END DO ! J - All wave excitation forces and moments + DO J = 1,6 ! Loop through all wave excitation forces and moments + TmpCoord(1) = Omega + TmpCoord(2) = InitInp%WaveDirArr(I) + CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I)) + END DO ! J - All wave excitation forces and moments - END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Dump the HdroFreq variable to a file for debugging -! Open and write header info to the HydroDyn Output File -!CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\HdroFreq_HD.txt', ErrStat ) ! Open motion file. -!DO K = 1, NInpFreq -! WRITE ( 66, '(2(e20.9))', IOSTAT = ErrStat) REAL(K), HdroFreq(K) -!END DO -!CLOSE ( 66 ) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Dump the WaveElevCO variable to a file for debugging -! Open and write header info to the HydroDyn Output File -!CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\WaveElevC0_HD.txt', ErrStat ) ! Open motion file. -!DO K = 0, InitInp%NStepWave2 -! WRITE ( 66, '(2(e20.9))', IOSTAT = ErrStat) REAL(K), REAL(InitInp%WaveElevC0(K)) -!END DO -!CLOSE ( 66 ) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Dump the WaveExctnC variable to a file for debugging -! Open and write header info to the HydroDyn Output File -!CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\WaveExctnC_HD.txt', ErrStat ) ! Open motion file. -!DO K = 0, InitInp%NStepWave2 -! WRITE ( 66, '(7(e20.9))', IOSTAT = ErrStat) REAL(K), REAL(WaveExctnC(K,:)) -!END DO -!CLOSE ( 66 ) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Compute the inverse discrete Fourier transform to find the time-domain - ! representation of the wave excitation force: - - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .TRUE., ErrStat2 ) - CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Dump the HdroFreq variable to a file for debugging + ! Open and write header info to the HydroDyn Output File + !CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\HdroFreq_HD.txt', ErrStat ) ! Open motion file. + !DO K = 1, NInpFreq + ! WRITE ( 66, '(2(e20.9))', IOSTAT = ErrStat) REAL(K), HdroFreq(K) + !END DO + !CLOSE ( 66 ) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Dump the WaveElevCO variable to a file for debugging + ! Open and write header info to the HydroDyn Output File + !CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\WaveElevC0_HD.txt', ErrStat ) ! Open motion file. + !DO K = 0, InitInp%NStepWave2 + ! WRITE ( 66, '(2(e20.9))', IOSTAT = ErrStat) REAL(K), REAL(InitInp%WaveElevC0(K)) + !END DO + !CLOSE ( 66 ) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Dump the WaveExctnC variable to a file for debugging + ! Open and write header info to the HydroDyn Output File + !CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\WaveExctnC_HD.txt', ErrStat ) ! Open motion file. + !DO K = 0, InitInp%NStepWave2 + ! WRITE ( 66, '(7(e20.9))', IOSTAT = ErrStat) REAL(K), REAL(WaveExctnC(K,:)) + !END DO + !CLOSE ( 66 ) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Compute the inverse discrete Fourier transform to find the time-domain + ! representation of the wave excitation force: + + CALL InitFFT ( InitInp%NStepWave, FFT_Data, .TRUE., ErrStat2 ) + CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF - DO J = 1,6 ! Loop through all wave excitation forces and moments - CALL ApplyFFT_cx ( p%WaveExctn(0:InitInp%NStepWave-1,J), WaveExctnC(:,J), FFT_Data, ErrStat2 ) - CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + DO J = 1,6 ! Loop through all wave excitation forces and moments + CALL ApplyFFT_cx ( p%WaveExctn(0:InitInp%NStepWave-1,J), WaveExctnC(:,J), FFT_Data, ErrStat2 ) + CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, 'WAMIT_Init') + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF - ! Append first datpoint as the last as aid for repeated wave data - p%WaveExctn(InitInp%NStepWave,J) = p%WaveExctn(0,J) - END DO ! J - All wave excitation forces and moments - - CALL ExitFFT(FFT_Data, ErrStat2) - CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - CASE ( 6 ) ! User wave data. + ! Append first datpoint as the last as aid for repeated wave data + p%WaveExctn(InitInp%NStepWave,J) = p%WaveExctn(0,J) + END DO ! J - All wave excitation forces and moments + + CALL ExitFFT(FFT_Data, ErrStat2) + CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + else if ( p%ExctnMod == 2 ) then + Interval_Sub = InitInp%Conv_Rdtn%RdtnDT + SS_Exctn_InitInp%InputFile = InitInp%WAMITFile + SS_Exctn_InitInp%WaveDir = InitInp%WaveDir + SS_Exctn_InitInp%NStepWave = p%NStepWave + + ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module + IF (ALLOCATED(InitInp%WaveElev0)) CALL MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) + + ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation + ALLOCATE ( SS_Exctn_InitInp%WaveTime (0:InitInp%NStepWave) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the SS_Exctn_InitInp%WaveTime array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN + END IF + SS_Exctn_InitInp%WaveTime = InitInp%WaveTime + + call SS_Exc_Init(SS_Exctn_InitInp, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, & + m%SS_Exctn_y, m%SS_Exctn, Interval_Sub, SS_Exctn_InitOut, ErrStat2, ErrMsg2) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + end if + + CASE ( 6 ) ! User wave data. - CALL SetErrStat( ErrID_Fatal, 'User input wave data not applicable for floating platforms.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN + CALL SetErrStat( ErrID_Fatal, 'User input wave data not applicable for floating platforms.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL Cleanup() + RETURN - ENDSELECT - + ENDSELECT + end if IF ( InitInp%RdtnTMax == 0.0 ) THEN ! .TRUE. when we don't want to model wave radiation damping; set RdtnTMax to some minimum value greater than zero to avoid an error in the calculations below. @@ -1047,22 +1110,22 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL Cleanup() RETURN END IF - + + ELSE IF ( InitInp%RdtnMod == 2 ) THEN SS_Rdtn_InitInp%InputFile = InitInp%WAMITFile SS_Rdtn_InitInp%DOFs = 1 + Interval_Sub = InitInp%Conv_Rdtn%RdtnDT CALL SS_Rad_Init(SS_Rdtn_InitInp, m%SS_Rdtn_u, p%SS_Rdtn, x%SS_Rdtn, xd%SS_Rdtn, z%SS_Rdtn, OtherState%SS_Rdtn, & - m%SS_Rdtn_y, m%SS_Rdtn, Interval, SS_Rdtn_InitOut, ErrStat2, ErrMsg2) + m%SS_Rdtn_y, m%SS_Rdtn, Interval_Sub, SS_Rdtn_InitOut, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN - END IF - - + END IF END IF @@ -1084,9 +1147,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF ( ALLOCATED( WAMITWvDir ) ) DEALLOCATE( WAMITWvDir ) IF ( ALLOCATED( SortFreqInd ) ) DEALLOCATE( SortFreqInd ) IF ( ALLOCATED( SortWvDirInd ) ) DEALLOCATE( SortWvDirInd ) - ! Define parameters here: - - p%DT = Interval + ! Define system output initializations (set up mesh) here: @@ -1174,10 +1235,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END IF - ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which - ! this module must be called here: - - !Interval = p%DT + ! initialize misc vars: m%LastIndWave = 1 @@ -1196,6 +1254,8 @@ SUBROUTINE Cleanup() CALL SS_Rad_DestroyInitInput( SS_Rdtn_InitInp, ErrStat2, ErrMsg2 ) CALL SS_Rad_DestroyInitOutput( SS_Rdtn_InitOut, ErrStat2, ErrMsg2 ) + CALL SS_Exc_DestroyInitInput( SS_Exctn_InitInp, ErrStat2, ErrMsg2 ) + CALL SS_Exc_DestroyInitOutput( SS_Exctn_InitOut, ErrStat2, ErrMsg2 ) ! destroy local variables that are allocatable arrays: @@ -1313,6 +1373,7 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState TYPE(Conv_Rdtn_InputType), ALLOCATABLE :: Conv_Rdtn_u(:) ! Inputs TYPE(SS_Rad_InputType), ALLOCATABLE :: SS_Rdtn_u(:) ! Inputs + TYPE(SS_Exc_InputType), ALLOCATABLE :: SS_Exctn_u(:) ! Inputs @@ -1369,7 +1430,21 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState END IF - + if ( p%ExctnMod == 2 ) then ! Update the state-space wave excitation sub-module's states + + ! Allocate array of dummy SS_Excitation inputs for the framework + + allocate( SS_Exctn_u(nTime), STAT = ErrStat ) + if (ErrStat /=0) then + ErrMsg = ' Failed to allocate array SS_Exctn_u.' + return + end if + + call SS_Exc_UpdateStates( t, n, SS_Exctn_u, InputTimes, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn, ErrStat, ErrMsg ) + + deallocate(SS_Exctn_u) + + end if END SUBROUTINE WAMIT_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- @@ -1412,21 +1487,34 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Compute outputs here: - ! Abort if the wave excitation loads have not been computed yet: - - IF ( .NOT. ALLOCATED ( p%WaveExctn ) ) THEN - ErrMsg = ' Routine WAMIT_Init() must be called before routine WAMIT_CalcOutput().' - ErrStat = ErrID_Fatal - RETURN - END IF ! Compute the load contribution from incident waves (i.e., the diffraction problem): + if ( p%ExctnMod == 0 ) then + + m%F_Waves1 = 0.0_ReKi + + else if ( p%ExctnMod == 1 ) then + + ! Abort if the wave excitation loads have not been computed yet: + IF ( .NOT. ALLOCATED ( p%WaveExctn ) ) THEN + ErrMsg = ' Routine WAMIT_Init() must be called before routine WAMIT_CalcOutput().' + ErrStat = ErrID_Fatal + RETURN + END IF - DO I = 1,6 ! Loop through all wave excitation forces and moments - m%F_Waves1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveTime(:), p%WaveExctn(:,I), & - m%LastIndWave, p%NStepWave + 1 ) - END DO ! I - All wave excitation forces and moments + DO I = 1,6 ! Loop through all wave excitation forces and moments + m%F_Waves1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveTime(:), p%WaveExctn(:,I), & + m%LastIndWave, p%NStepWave + 1 ) + END DO ! I - All wave excitation forces and moments + + else if ( p%ExctnMod == 2 ) then + + call SS_Exc_CalcOutput( Time, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, & + z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn_y, m%SS_Exctn, ErrStat, ErrMsg ) + m%F_Waves1 (:) = m%SS_Exctn_y%y + + end if @@ -1554,12 +1642,16 @@ SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrMsg = "" - ! Compute the first time derivatives of the continuous states here: - m%SS_Rdtn_u%dq(1:3) = u%Mesh%TranslationVel(:,1) - m%SS_Rdtn_u%dq(4:6) = u%Mesh%RotationVel(:,1) + ! Compute the first time derivatives of the continuous states here: + m%SS_Rdtn_u%dq(1:3) = u%Mesh%TranslationVel(:,1) + m%SS_Rdtn_u%dq(4:6) = u%Mesh%RotationVel(:,1) + + CALL SS_Rad_CalcContStateDeriv( Time, m%SS_Rdtn_u, p%SS_Rdtn, x%SS_Rdtn, xd%SS_Rdtn, z%SS_Rdtn, OtherState%SS_Rdtn, m%SS_Rdtn, dxdt%SS_Rdtn, ErrStat, ErrMsg ) - CALL SS_Rad_CalcContStateDeriv( Time, m%SS_Rdtn_u, p%SS_Rdtn, x%SS_Rdtn, xd%SS_Rdtn, z%SS_Rdtn, OtherState%SS_Rdtn, m%SS_Rdtn, dxdt%SS_Rdtn, ErrStat, ErrMsg ) - + ! NOTE: The input below (0.0) will only work as part of a linearization Get_OP call! If this routine (WAMIT_CalcContStateDeriv) is called in another context, then the following + ! input needs to be implemented generically. + CALL SS_Exc_CalcContStateDeriv( Time, 0.0_SiKi, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn, dxdt%SS_Exctn, ErrStat, ErrMsg ) + END SUBROUTINE WAMIT_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 9fa7a1b693..b4aedf027e 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -15,6 +15,7 @@ include Registry_NWTC_Library.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt +usefrom SS_Excitation.txt usefrom Waves.txt param WAMIT/WAMIT unused INTEGER MaxWAMITOutputs - 18 - "" - typedef WAMIT/WAMIT InitInputType ReKi PtfmVol0 - - - "" - @@ -23,14 +24,18 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi PtfmCOBxt - - - "" - typedef ^ ^ ReKi PtfmCOByt - - - "" - typedef ^ ^ INTEGER RdtnMod - - - "" - +typedef ^ ^ INTEGER ExctnMod - - - "" - typedef ^ ^ DbKi RdtnTMax - - - "" - +typedef ^ ^ ReKi WaveDir - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - -typedef ^ ^ SS_Rad_InitInputType SS_Rdtn - - - "" - +#typedef ^ ^ SS_Rad_InitInputType SS_Rdtn - - - "" - +#typedef ^ ^ SS_Exc_InitInputType SS_Excn - - - "" - typedef ^ ^ ReKi Rhoxg - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ ReKi WaveDOmega - - - "" - +typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveTime {:} - - "" - typedef ^ ^ INTEGER WaveMod - - - "" - @@ -38,7 +43,7 @@ typedef ^ ^ ReKi typedef ^ ^ SiKi WaveDirArr {:} - - "Array of wave directions (one per frequency) from the Waves module" - typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - -typedef ^ ^ CHARACTER(10) OutList {18} - - "This should really be dimensioned with MaxOutPts" - +typedef ^ ^ CHARACTER(ChanLen) OutList {18} - - "This should really be dimensioned with MaxOutPts" - typedef ^ ^ LOGICAL OutAll - - - "" - typedef ^ ^ INTEGER NumOuts - - - "" - # @@ -46,14 +51,15 @@ typedef ^ ^ INTEGER # Define outputs from the initialization routine here: # #typedef ^ InitOutputType MeshType OutputMesh - - - "" - -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "" - -typedef ^ ^ CHARACTER(10) WriteOutputUnt {:} - - "" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - # # # ..... States .................................................................................................................... # Define continuous (differentiable) states here: # typedef ^ ContinuousStateType SS_Rad_ContinuousStateType SS_Rdtn - - - "continuous states from the State Space radiation module" - +typedef ^ ContinuousStateType SS_Exc_ContinuousStateType SS_Exctn - - - "continuous states from the State Space radiation module" - typedef ^ ^ Conv_Rdtn_ContinuousStateType Conv_Rdtn - - - "placeholder" - # # @@ -61,17 +67,20 @@ typedef ^ ^ Conv_Rdtn_C # typedef ^ DiscreteStateType Conv_Rdtn_DiscreteStateType Conv_Rdtn - - - "discrete states from the convolution radiation module" - typedef ^ DiscreteStateType SS_Rad_DiscreteStateType SS_Rdtn - - - "placeholder" - +typedef ^ DiscreteStateType SS_Exc_DiscreteStateType SS_Exctn - - - "placeholder" - # # # Define constraint states here: # typedef ^ ConstraintStateType Conv_Rdtn_ConstraintStateType Conv_Rdtn - - - "placeholder" - typedef ^ ConstraintStateType SS_Rad_ConstraintStateType SS_Rdtn - - - "placeholder" - +typedef ^ ConstraintStateType SS_Exc_ConstraintStateType SS_Exctn - - - "placeholder" - # # # Define any data that are integer or logical states here: typedef ^ OtherStateType SS_Rad_OtherStateType SS_Rdtn - - - "" - +typedef ^ OtherStateType SS_Exc_OtherStateType SS_Exctn - - - "" - typedef ^ ^ Conv_Rdtn_OtherStateType Conv_Rdtn - - - "" - @@ -87,6 +96,9 @@ typedef ^ ^ ReKi typedef ^ ^ SS_Rad_MiscVarType SS_Rdtn - - - "" - typedef ^ ^ SS_Rad_InputType SS_Rdtn_u - - - "" - typedef ^ ^ SS_Rad_OutputType SS_Rdtn_y - - - "" - +typedef ^ ^ SS_Exc_MiscVarType SS_Exctn - - - "" - +typedef ^ ^ SS_Exc_InputType SS_Exctn_u - - - "" - +typedef ^ ^ SS_Exc_OutputType SS_Exctn_y - - - "" - typedef ^ ^ Conv_Rdtn_MiscVarType Conv_Rdtn - - - "" - typedef ^ ^ Conv_Rdtn_InputType Conv_Rdtn_u - - - "" - typedef ^ ^ Conv_Rdtn_OutputType Conv_Rdtn_y - - - "" - @@ -101,12 +113,14 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi PtfmCOBxt - - - "" - typedef ^ ^ ReKi PtfmCOByt - - - "" - typedef ^ ^ INTEGER RdtnMod - - - "" - +typedef ^ ^ INTEGER ExctnMod - - - "" - typedef ^ ^ SiKi WaveExctn {:}{:} - - "" - typedef ^ ^ ReKi RhoXg - - - "" - typedef ^ ^ SiKi WaveTime {:} - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ Conv_Rdtn_ParameterType Conv_Rdtn - - - "" - typedef ^ ^ SS_Rad_ParameterType SS_Rdtn - - - "" - +typedef ^ ^ SS_Exc_ParameterType SS_Exctn - - - "" - typedef ^ ^ DbKi DT - - - "" - typedef ^ ^ LOGICAL PtfmSgF - - - "" - typedef ^ ^ LOGICAL PtfmSwF - - - "" - @@ -119,7 +133,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - # # diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 05c45bde52..af88651924 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -65,8 +65,6 @@ MODULE WAMIT2 ! INTEGER(IntKi), PARAMETER :: DataFormatID = 1 !< Update this value if the data types change (used in WAMIT_Pack) TYPE(ProgDesc), PARAMETER :: WAMIT2_ProgDesc = ProgDesc( 'WAMIT2', '', '' ) !< This holds the name of the program, version info, and date. - !! It is used by the DispNVD routine in the library and as header - !! information in output files. REAL(DbKi), PARAMETER, PRIVATE :: OnePlusEps = 1.0 + EPSILON(OnePlusEps) ! The number slighty greater than unity in the precision of DbKi. @@ -278,7 +276,6 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !> Initialize the NWTC Subroutine Library and display the information about this module. CALL NWTC_Init() ! WAMIT2_ProgDesc%Name, '('//WAMIT2_ProgDesc%Ver//','//WAMIT2_ProgDesc%Date//')', EchoLibVer = .FALSE. ) - !CALL DispNVD( WAMIT2_ProgDesc ) diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index c52b346abc..4226c37ca4 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -36,7 +36,7 @@ typedef ^ ^ SiKi WaveDirMin typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - typedef ^ ^ SiKi WaveTime {:} - - "Simulation times at which the instantaneous second order loads associated with the incident waves are determined" sec -typedef ^ ^ CHARACTER(10) OutList {27} - - "This should really be dimensioned with MaxOutPts" - +typedef ^ ^ CHARACTER(ChanLen) OutList {27} - - "This should really be dimensioned with MaxOutPts" - typedef ^ ^ LOGICAL OutAll - - - "" - typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER NumOutAll - - - "" - @@ -70,8 +70,8 @@ typedef ^ ^ ReKi WvHiCOffS # Define outputs from the initialization routine here: # #typedef ^ InitOutputType MeshType OutputMesh - - - "" - -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "" - -typedef ^ ^ CHARACTER(10) WriteOutputUnt {:} - - "" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - # ..... States .................................................................................................................... @@ -126,7 +126,7 @@ typedef ^ ^ INTEGER NumOuts typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - diff --git a/modules/hydrodyn/src/WAMIT2_Output.f90 b/modules/hydrodyn/src/WAMIT2_Output.f90 index 1ca00ee50a..c77b4ebe02 100644 --- a/modules/hydrodyn/src/WAMIT2_Output.f90 +++ b/modules/hydrodyn/src/WAMIT2_Output.f90 @@ -292,8 +292,8 @@ FUNCTION GetWAMIT2Channels ( NUserOutputs, UserOutputs, OutList, foundMask, !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(10), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(10), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT2 output channels. + CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT2 output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -306,7 +306,7 @@ FUNCTION GetWAMIT2Channels ( NUserOutputs, UserOutputs, OutList, foundMask, INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. ! LOGICAL :: InvalidOutput(MaxWAMIT2Outputs) ! This array determines if the output channel is valid for this configuration LOGICAL :: CheckOutListAgain @@ -405,9 +405,9 @@ SUBROUTINE WMT2OUT_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) TYPE(WAMIT2_OutputType), INTENT( INOUT ) :: y ! This module's internal data TYPE(WAMIT2_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the WAMIT2 platform module - CHARACTER(10), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. + INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! Local variables. @@ -415,7 +415,7 @@ SUBROUTINE WMT2OUT_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) ! INTEGER :: J ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 6c9e6f82ac..af1cddd8dd 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -52,7 +52,7 @@ MODULE WAMIT2_Types REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - CHARACTER(10) , DIMENSION(1:27) :: OutList !< This should really be dimensioned with MaxOutPts [-] + CHARACTER(ChanLen) , DIMENSION(1:27) :: OutList !< This should really be dimensioned with MaxOutPts [-] LOGICAL :: OutAll !< [-] INTEGER(IntKi) :: NumOuts !< [-] INTEGER(IntKi) :: NumOutAll !< [-] @@ -81,8 +81,8 @@ MODULE WAMIT2_Types ! ======================= ! ========= WAMIT2_InitOutputType ======= TYPE, PUBLIC :: WAMIT2_InitOutputType - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] END TYPE WAMIT2_InitOutputType ! ======================= ! ========= WAMIT2_ContinuousStateType ======= @@ -130,7 +130,7 @@ MODULE WAMIT2_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE WAMIT2_ParameterType ! ======================= @@ -375,26 +375,26 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasWAMIT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WAMITULEN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -408,13 +408,17 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -425,13 +429,15 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -442,63 +448,65 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + 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 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MnDrift - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NewmanApp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DiffQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MnDriftF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NewmanAppF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MnDrift + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NewmanApp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DiffQTF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumQTF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackInitInput SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -514,12 +522,6 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -535,26 +537,26 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%HasWAMIT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RhoXg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WAMITULEN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RhoXg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -571,20 +573,17 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) - END IF - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -598,20 +597,15 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) - END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -625,79 +619,67 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MnDrift = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanApp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MnDriftF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSgF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF2) + Int_Xferred = Int_Xferred + 1 + OutData%MnDrift = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanApp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackInitInput SUBROUTINE WAMIT2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -840,12 +822,12 @@ SUBROUTINE WAMIT2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -857,12 +839,12 @@ SUBROUTINE WAMIT2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE WAMIT2_PackInitOutput @@ -879,12 +861,6 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -912,19 +888,12 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -939,19 +908,12 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE WAMIT2_UnPackInitOutput @@ -1046,8 +1008,8 @@ SUBROUTINE WAMIT2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackContState SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1063,12 +1025,6 @@ SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackContState' @@ -1082,8 +1038,8 @@ SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackContState SUBROUTINE WAMIT2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1177,8 +1133,8 @@ SUBROUTINE WAMIT2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackDiscState SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1194,12 +1150,6 @@ SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackDiscState' @@ -1213,8 +1163,8 @@ SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackDiscState SUBROUTINE WAMIT2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1308,8 +1258,8 @@ SUBROUTINE WAMIT2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackConstrState SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1325,12 +1275,6 @@ SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackConstrState' @@ -1344,8 +1288,8 @@ SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackConstrState SUBROUTINE WAMIT2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1439,8 +1383,8 @@ SUBROUTINE WAMIT2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_PackOtherState SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1456,12 +1400,6 @@ SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackOtherState' @@ -1475,8 +1413,8 @@ SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_UnPackOtherState SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1573,10 +1511,12 @@ SUBROUTINE WAMIT2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves2))-1 ) = PACK(InData%F_Waves2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves2) + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_Waves2,1), UBOUND(InData%F_Waves2,1) + ReKiBuf(Re_Xferred) = InData%F_Waves2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE WAMIT2_PackMisc SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1592,12 +1532,6 @@ SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1612,19 +1546,14 @@ SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_Waves2,1) i1_u = UBOUND(OutData%F_Waves2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves2,1), UBOUND(OutData%F_Waves2,1) + OutData%F_Waves2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE WAMIT2_UnPackMisc SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1848,13 +1777,15 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveExctn2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1868,25 +1799,37 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveExctn2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveExctn2))-1 ) = PACK(InData%WaveExctn2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveExctn2) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%MnDriftDims)-1 ) = TRANSFER(PACK( InData%MnDriftDims ,.TRUE.), IntKiBuf(1), SIZE(InData%MnDriftDims)) - Int_Xferred = Int_Xferred + SIZE(InData%MnDriftDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%NewmanAppDims)-1 ) = TRANSFER(PACK( InData%NewmanAppDims ,.TRUE.), IntKiBuf(1), SIZE(InData%NewmanAppDims)) - Int_Xferred = Int_Xferred + SIZE(InData%NewmanAppDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%DiffQTFDims)-1 ) = TRANSFER(PACK( InData%DiffQTFDims ,.TRUE.), IntKiBuf(1), SIZE(InData%DiffQTFDims)) - Int_Xferred = Int_Xferred + SIZE(InData%DiffQTFDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%SumQTFDims)-1 ) = TRANSFER(PACK( InData%SumQTFDims ,.TRUE.), IntKiBuf(1), SIZE(InData%SumQTFDims)) - Int_Xferred = Int_Xferred + SIZE(InData%SumQTFDims) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MnDriftF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NewmanAppF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%WaveExctn2,2), UBOUND(InData%WaveExctn2,2) + DO i1 = LBOUND(InData%WaveExctn2,1), UBOUND(InData%WaveExctn2,1) + ReKiBuf(Re_Xferred) = InData%WaveExctn2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%MnDriftDims,1), UBOUND(InData%MnDriftDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%NewmanAppDims,1), UBOUND(InData%NewmanAppDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%DiffQTFDims,1), UBOUND(InData%DiffQTFDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SumQTFDims,1), UBOUND(InData%SumQTFDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1928,24 +1871,24 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_PackParam SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1961,12 +1904,6 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1995,20 +1932,15 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) - END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2025,68 +1957,45 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveExctn2)>0) OutData%WaveExctn2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveExctn2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveExctn2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveExctn2,2), UBOUND(OutData%WaveExctn2,2) + DO i1 = LBOUND(OutData%WaveExctn2,1), UBOUND(OutData%WaveExctn2,1) + OutData%WaveExctn2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MnDriftDims,1) i1_u = UBOUND(OutData%MnDriftDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MnDriftDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MnDriftDims))-1 ), OutData%MnDriftDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%MnDriftDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MnDriftDims,1), UBOUND(OutData%MnDriftDims,1) + OutData%MnDriftDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%NewmanAppDims,1) i1_u = UBOUND(OutData%NewmanAppDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%NewmanAppDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NewmanAppDims))-1 ), OutData%NewmanAppDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%NewmanAppDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NewmanAppDims,1), UBOUND(OutData%NewmanAppDims,1) + OutData%NewmanAppDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%DiffQTFDims,1) i1_u = UBOUND(OutData%DiffQTFDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DiffQTFDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DiffQTFDims))-1 ), OutData%DiffQTFDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%DiffQTFDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DiffQTFDims,1), UBOUND(OutData%DiffQTFDims,1) + OutData%DiffQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%SumQTFDims,1) i1_u = UBOUND(OutData%SumQTFDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SumQTFDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SumQTFDims))-1 ), OutData%SumQTFDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%SumQTFDims) - DEALLOCATE(mask1) - OutData%MnDriftF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SumQTFDims,1), UBOUND(OutData%SumQTFDims,1) + OutData%SumQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2143,24 +2052,24 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_UnPackParam SUBROUTINE WAMIT2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -2317,12 +2226,6 @@ SUBROUTINE WAMIT2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackInput' @@ -2548,8 +2451,10 @@ SUBROUTINE WAMIT2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT2_PackOutput @@ -2566,12 +2471,6 @@ SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2639,15 +2538,10 @@ SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT2_UnPackOutput @@ -2726,8 +2620,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2742,6 +2636,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT2_Input_ExtrapInterp1 @@ -2773,8 +2669,9 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Input_ExtrapInterp2' @@ -2796,6 +2693,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT2_Input_ExtrapInterp2 @@ -2875,12 +2774,12 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2893,15 +2792,15 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE WAMIT2_Output_ExtrapInterp1 @@ -2932,13 +2831,14 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2957,16 +2857,16 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE WAMIT2_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/WAMIT_Output.f90 b/modules/hydrodyn/src/WAMIT_Output.f90 index 30d0fa16cc..51fb78d93e 100644 --- a/modules/hydrodyn/src/WAMIT_Output.f90 +++ b/modules/hydrodyn/src/WAMIT_Output.f90 @@ -321,8 +321,8 @@ FUNCTION GetWAMITChannels ( NUserOutputs, UserOutputs, OutList, foundMask, !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(10), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(10), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. + CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -335,7 +335,7 @@ FUNCTION GetWAMITChannels ( NUserOutputs, UserOutputs, OutList, foundMask, INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. ! LOGICAL :: InvalidOutput(MaxWAMITOutputs) ! This array determines if the output channel is valid for this configuration LOGICAL :: CheckOutListAgain @@ -433,7 +433,7 @@ SUBROUTINE WMTOUT_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) TYPE(WAMIT_OutputType), INTENT( INOUT ) :: y ! This module's internal data TYPE(WAMIT_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the WAMIT platform module - CHARACTER(10), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -443,7 +443,7 @@ SUBROUTINE WMTOUT_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) ! INTEGER :: J ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 9f6ada0d77..b321d69848 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -33,6 +33,7 @@ MODULE WAMIT_Types !--------------------------------------------------------------------------------------------------------------------------------- USE Conv_Radiation_Types USE SS_Radiation_Types +USE SS_Excitation_Types USE Waves_Types USE NWTC_Library IMPLICIT NONE @@ -45,14 +46,16 @@ MODULE WAMIT_Types REAL(ReKi) :: PtfmCOBxt !< [-] REAL(ReKi) :: PtfmCOByt !< [-] INTEGER(IntKi) :: RdtnMod !< [-] + INTEGER(IntKi) :: ExctnMod !< [-] REAL(DbKi) :: RdtnTMax !< [-] + REAL(ReKi) :: WaveDir !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] - TYPE(SS_Rad_InitInputType) :: SS_Rdtn !< [-] REAL(ReKi) :: Rhoxg !< [-] INTEGER(IntKi) :: NStepWave !< [-] INTEGER(IntKi) :: NStepWave2 !< [-] REAL(ReKi) :: WaveDOmega !< [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin (needed for SS_Excitation module) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] INTEGER(IntKi) :: WaveMod !< [-] @@ -60,20 +63,21 @@ MODULE WAMIT_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Array of wave directions (one per frequency) from the Waves module [-] REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] - CHARACTER(10) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] + CHARACTER(ChanLen) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] LOGICAL :: OutAll !< [-] INTEGER(IntKi) :: NumOuts !< [-] END TYPE WAMIT_InitInputType ! ======================= ! ========= WAMIT_InitOutputType ======= TYPE, PUBLIC :: WAMIT_InitOutputType - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] END TYPE WAMIT_InitOutputType ! ======================= ! ========= WAMIT_ContinuousStateType ======= TYPE, PUBLIC :: WAMIT_ContinuousStateType TYPE(SS_Rad_ContinuousStateType) :: SS_Rdtn !< continuous states from the State Space radiation module [-] + TYPE(SS_Exc_ContinuousStateType) :: SS_Exctn !< continuous states from the State Space radiation module [-] TYPE(Conv_Rdtn_ContinuousStateType) :: Conv_Rdtn !< placeholder [-] END TYPE WAMIT_ContinuousStateType ! ======================= @@ -81,17 +85,20 @@ MODULE WAMIT_Types TYPE, PUBLIC :: WAMIT_DiscreteStateType TYPE(Conv_Rdtn_DiscreteStateType) :: Conv_Rdtn !< discrete states from the convolution radiation module [-] TYPE(SS_Rad_DiscreteStateType) :: SS_Rdtn !< placeholder [-] + TYPE(SS_Exc_DiscreteStateType) :: SS_Exctn !< placeholder [-] END TYPE WAMIT_DiscreteStateType ! ======================= ! ========= WAMIT_ConstraintStateType ======= TYPE, PUBLIC :: WAMIT_ConstraintStateType TYPE(Conv_Rdtn_ConstraintStateType) :: Conv_Rdtn !< placeholder [-] TYPE(SS_Rad_ConstraintStateType) :: SS_Rdtn !< placeholder [-] + TYPE(SS_Exc_ConstraintStateType) :: SS_Exctn !< placeholder [-] END TYPE WAMIT_ConstraintStateType ! ======================= ! ========= WAMIT_OtherStateType ======= TYPE, PUBLIC :: WAMIT_OtherStateType TYPE(SS_Rad_OtherStateType) :: SS_Rdtn !< [-] + TYPE(SS_Exc_OtherStateType) :: SS_Exctn !< [-] TYPE(Conv_Rdtn_OtherStateType) :: Conv_Rdtn !< [-] END TYPE WAMIT_OtherStateType ! ======================= @@ -106,6 +113,9 @@ MODULE WAMIT_Types TYPE(SS_Rad_MiscVarType) :: SS_Rdtn !< [-] TYPE(SS_Rad_InputType) :: SS_Rdtn_u !< [-] TYPE(SS_Rad_OutputType) :: SS_Rdtn_y !< [-] + TYPE(SS_Exc_MiscVarType) :: SS_Exctn !< [-] + TYPE(SS_Exc_InputType) :: SS_Exctn_u !< [-] + TYPE(SS_Exc_OutputType) :: SS_Exctn_y !< [-] TYPE(Conv_Rdtn_MiscVarType) :: Conv_Rdtn !< [-] TYPE(Conv_Rdtn_InputType) :: Conv_Rdtn_u !< [-] TYPE(Conv_Rdtn_OutputType) :: Conv_Rdtn_y !< [-] @@ -119,12 +129,14 @@ MODULE WAMIT_Types REAL(ReKi) :: PtfmCOBxt !< [-] REAL(ReKi) :: PtfmCOByt !< [-] INTEGER(IntKi) :: RdtnMod !< [-] + INTEGER(IntKi) :: ExctnMod !< [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn !< [-] REAL(ReKi) :: RhoXg !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] INTEGER(IntKi) :: NStepWave !< [-] TYPE(Conv_Rdtn_ParameterType) :: Conv_Rdtn !< [-] TYPE(SS_Rad_ParameterType) :: SS_Rdtn !< [-] + TYPE(SS_Exc_ParameterType) :: SS_Exctn !< [-] REAL(DbKi) :: DT !< [-] LOGICAL :: PtfmSgF !< [-] LOGICAL :: PtfmSwF !< [-] @@ -137,7 +149,7 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE WAMIT_ParameterType ! ======================= @@ -175,18 +187,29 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod + DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax + DstInitInputData%WaveDir = SrcInitInputData%WaveDir DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile CALL Conv_Rdtn_CopyInitInput( SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyInitInput( SrcInitInputData%SS_Rdtn, DstInitInputData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega +IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElev0,1) + i1_u = UBOUND(SrcInitInputData%WaveElev0,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN + ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 +ENDIF IF (ALLOCATED(SrcInitInputData%WaveElevC0)) THEN i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) @@ -244,7 +267,9 @@ SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat, ErrMsg ) - CALL SS_Rad_DestroyInitInput( InitInputData%SS_Rdtn, ErrStat, ErrMsg ) +IF (ALLOCATED(InitInputData%WaveElev0)) THEN + DEALLOCATE(InitInputData%WaveElev0) +ENDIF IF (ALLOCATED(InitInputData%WaveElevC0)) THEN DEALLOCATE(InitInputData%WaveElevC0) ENDIF @@ -297,7 +322,9 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_BufSz = Re_BufSz + 1 ! PtfmCOBxt Re_BufSz = Re_BufSz + 1 ! PtfmCOByt Int_BufSz = Int_BufSz + 1 ! RdtnMod + Int_BufSz = Int_BufSz + 1 ! ExctnMod Db_BufSz = Db_BufSz + 1 ! RdtnTMax + Re_BufSz = Re_BufSz + 1 ! WaveDir Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype @@ -317,27 +344,15 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF Re_BufSz = Re_BufSz + 1 ! Rhoxg Int_BufSz = Int_BufSz + 1 ! NStepWave Int_BufSz = Int_BufSz + 1 ! NStepWave2 Re_BufSz = Re_BufSz + 1 ! WaveDOmega + Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no + IF ( ALLOCATED(InData%WaveElev0) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 + END IF Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no IF ( ALLOCATED(InData%WaveElevC0) ) THEN Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension @@ -387,24 +402,28 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmVol0 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasWAMIT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOBxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOByt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + ReKiBuf(Re_Xferred) = InData%PtfmVol0 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WAMITULEN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOBxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOByt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RdtnMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ExctnMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -433,42 +452,29 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL SS_Rad_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ReKiBuf(Re_Xferred) = InData%Rhoxg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rhoxg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -482,8 +488,12 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -495,13 +505,15 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -512,23 +524,25 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_PackInitInput SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -544,12 +558,6 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -565,64 +573,28 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%PtfmVol0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HasWAMIT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOBxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOByt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) + OutData%PtfmVol0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) + Int_Xferred = Int_Xferred + 1 + OutData%WAMITULEN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOBxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOByt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RdtnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ExctnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RdtnTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -656,21 +628,39 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SS_Rad_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn + CALL Conv_Rdtn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Rhoxg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Rhoxg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -687,15 +677,12 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -710,20 +697,15 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -737,39 +719,27 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_UnPackInitInput SUBROUTINE WAMIT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -912,12 +882,12 @@ SUBROUTINE WAMIT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -929,12 +899,12 @@ SUBROUTINE WAMIT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE WAMIT_PackInitOutput @@ -951,12 +921,6 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -984,19 +948,12 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1011,19 +968,12 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE WAMIT_UnPackInitOutput @@ -1044,6 +994,9 @@ SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er CALL SS_Rad_CopyContState( SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyContState( SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL Conv_Rdtn_CopyContState( SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -1059,6 +1012,7 @@ SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg ) 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 ) END SUBROUTINE WAMIT_DestroyContState @@ -1115,6 +1069,23 @@ SUBROUTINE WAMIT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype + CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype CALL Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1163,6 +1134,34 @@ SUBROUTINE WAMIT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -1230,12 +1229,6 @@ SUBROUTINE WAMIT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackContState' @@ -1286,6 +1279,46 @@ SUBROUTINE WAMIT_UnPackContState( 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) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -1351,6 +1384,9 @@ SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er CALL SS_Rad_CopyDiscState( SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyDiscState( SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyDiscState SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) @@ -1364,6 +1400,7 @@ SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) 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 ) END SUBROUTINE WAMIT_DestroyDiscState SUBROUTINE WAMIT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1436,6 +1473,23 @@ SUBROUTINE WAMIT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype + CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1519,27 +1573,49 @@ SUBROUTINE WAMIT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE WAMIT_PackDiscState + CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE WAMIT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE WAMIT_PackDiscState + + SUBROUTINE WAMIT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables INTEGER(IntKi) :: Buf_size INTEGER(IntKi) :: Re_Xferred INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackDiscState' @@ -1633,6 +1709,46 @@ SUBROUTINE WAMIT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE WAMIT_UnPackDiscState SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1655,6 +1771,9 @@ SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo CALL SS_Rad_CopyConstrState( SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyConstrState( SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyConstrState SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) @@ -1668,6 +1787,7 @@ SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) 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 ) END SUBROUTINE WAMIT_DestroyConstrState SUBROUTINE WAMIT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1740,6 +1860,23 @@ SUBROUTINE WAMIT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype + CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1823,6 +1960,34 @@ SUBROUTINE WAMIT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE WAMIT_PackConstrState SUBROUTINE WAMIT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1838,12 +2003,6 @@ SUBROUTINE WAMIT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackConstrState' @@ -1937,6 +2096,46 @@ SUBROUTINE WAMIT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE WAMIT_UnPackConstrState SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1956,6 +2155,9 @@ SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, CALL SS_Rad_CopyOtherState( SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyOtherState( SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL Conv_Rdtn_CopyOtherState( SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -1971,6 +2173,7 @@ SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) 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 ) END SUBROUTINE WAMIT_DestroyOtherState @@ -2027,6 +2230,23 @@ SUBROUTINE WAMIT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype + CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype CALL Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2075,6 +2295,34 @@ SUBROUTINE WAMIT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -2142,12 +2390,6 @@ SUBROUTINE WAMIT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackOtherState' @@ -2198,6 +2440,46 @@ SUBROUTINE WAMIT_UnPackOtherState( 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) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -2273,6 +2555,15 @@ SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) CALL SS_Rad_CopyOutput( SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyMisc( SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyInput( SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyOutput( SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL Conv_Rdtn_CopyMisc( SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -2296,6 +2587,9 @@ SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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 ) @@ -2394,6 +2688,57 @@ SUBROUTINE WAMIT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype + CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn_u: size of buffers for each call to pack subtype + CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn_y: size of buffers for each call to pack subtype + CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype CALL Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2472,18 +2817,28 @@ SUBROUTINE WAMIT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_HS))-1 ) = PACK(InData%F_HS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_HS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves1))-1 ) = PACK(InData%F_Waves1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves1) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Rdtn))-1 ) = PACK(InData%F_Rdtn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Rdtn) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAdd))-1 ) = PACK(InData%F_PtfmAdd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAdd) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_HS,1), UBOUND(InData%F_HS,1) + ReKiBuf(Re_Xferred) = InData%F_HS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Waves1,1), UBOUND(InData%F_Waves1,1) + ReKiBuf(Re_Xferred) = InData%F_Waves1(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) + ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2544,6 +2899,90 @@ SUBROUTINE WAMIT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -2667,12 +3106,6 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2687,63 +3120,38 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_HS,1) i1_u = UBOUND(OutData%F_HS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_HS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_HS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_HS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_HS,1), UBOUND(OutData%F_HS,1) + OutData%F_HS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Waves1,1) i1_u = UBOUND(OutData%F_Waves1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves1))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves1,1), UBOUND(OutData%F_Waves1,1) + OutData%F_Waves1(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Rdtn,1) i1_u = UBOUND(OutData%F_Rdtn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Rdtn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Rdtn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Rdtn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) + OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAdd,1) i1_u = UBOUND(OutData%F_PtfmAdd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAdd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAdd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAdd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) + OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2861,6 +3269,126 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_u, ErrStat2, ErrMsg2 ) ! SS_Exctn_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SS_Exc_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_y, ErrStat2, ErrMsg2 ) ! SS_Exctn_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -3008,6 +3536,7 @@ SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%PtfmCOBxt = SrcParamData%PtfmCOBxt DstParamData%PtfmCOByt = SrcParamData%PtfmCOByt DstParamData%RdtnMod = SrcParamData%RdtnMod + DstParamData%ExctnMod = SrcParamData%ExctnMod IF (ALLOCATED(SrcParamData%WaveExctn)) THEN i1_l = LBOUND(SrcParamData%WaveExctn,1) i1_u = UBOUND(SrcParamData%WaveExctn,1) @@ -3042,6 +3571,9 @@ SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs CALL SS_Rad_CopyParam( SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SS_Exc_CopyParam( SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN DstParamData%DT = SrcParamData%DT DstParamData%PtfmSgF = SrcParamData%PtfmSgF DstParamData%PtfmSwF = SrcParamData%PtfmSwF @@ -3090,6 +3622,7 @@ SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) 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 ) IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) @@ -3139,6 +3672,7 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = Re_BufSz + 1 ! PtfmCOBxt Re_BufSz = Re_BufSz + 1 ! PtfmCOByt Int_BufSz = Int_BufSz + 1 ! RdtnMod + Int_BufSz = Int_BufSz + 1 ! ExctnMod Int_BufSz = Int_BufSz + 1 ! WaveExctn allocated yes/no IF ( ALLOCATED(InData%WaveExctn) ) THEN Int_BufSz = Int_BufSz + 2*2 ! WaveExctn upper/lower bounds for each dimension @@ -3186,6 +3720,23 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype + CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Db_BufSz = Db_BufSz + 1 ! DT Int_BufSz = Int_BufSz + 1 ! PtfmSgF Int_BufSz = Int_BufSz + 1 ! PtfmSwF @@ -3249,18 +3800,28 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroAdMsI))-1 ) = PACK(InData%HdroAdMsI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroAdMsI) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroSttc))-1 ) = PACK(InData%HdroSttc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroSttc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmVol0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOBxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOByt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%HdroAdMsI,2), UBOUND(InData%HdroAdMsI,2) + DO i1 = LBOUND(InData%HdroAdMsI,1), UBOUND(InData%HdroAdMsI,1) + ReKiBuf(Re_Xferred) = InData%HdroAdMsI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%HdroSttc,2), UBOUND(InData%HdroSttc,2) + DO i1 = LBOUND(InData%HdroSttc,1), UBOUND(InData%HdroSttc,1) + ReKiBuf(Re_Xferred) = InData%HdroSttc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%PtfmVol0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOBxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOByt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RdtnMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ExctnMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveExctn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3274,11 +3835,15 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveExctn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveExctn))-1 ) = PACK(InData%WaveExctn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveExctn) + DO i2 = LBOUND(InData%WaveExctn,2), UBOUND(InData%WaveExctn,2) + DO i1 = LBOUND(InData%WaveExctn,1), UBOUND(InData%WaveExctn,1) + ReKiBuf(Re_Xferred) = InData%WaveExctn(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3289,11 +3854,13 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3350,20 +3917,48 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3405,24 +4000,24 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_PackParam SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3438,12 +4033,6 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3463,36 +4052,32 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM i1_u = UBOUND(OutData%HdroAdMsI,1) i2_l = LBOUND(OutData%HdroAdMsI,2) i2_u = UBOUND(OutData%HdroAdMsI,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HdroAdMsI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroAdMsI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroAdMsI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroAdMsI,2), UBOUND(OutData%HdroAdMsI,2) + DO i1 = LBOUND(OutData%HdroAdMsI,1), UBOUND(OutData%HdroAdMsI,1) + OutData%HdroAdMsI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%HdroSttc,1) i1_u = UBOUND(OutData%HdroSttc,1) i2_l = LBOUND(OutData%HdroSttc,2) i2_u = UBOUND(OutData%HdroSttc,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HdroSttc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroSttc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroSttc) - DEALLOCATE(mask2) - OutData%PtfmVol0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOBxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOByt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%HdroSttc,2), UBOUND(OutData%HdroSttc,2) + DO i1 = LBOUND(OutData%HdroSttc,1), UBOUND(OutData%HdroSttc,1) + OutData%HdroSttc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%PtfmVol0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOBxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOByt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RdtnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ExctnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3509,18 +4094,15 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveExctn)>0) OutData%WaveExctn = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveExctn))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveExctn) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveExctn,2), UBOUND(OutData%WaveExctn,2) + DO i1 = LBOUND(OutData%WaveExctn,1), UBOUND(OutData%WaveExctn,1) + OutData%WaveExctn(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%RhoXg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RhoXg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3534,18 +4116,13 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3626,20 +4203,60 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PtfmSgF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - 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 SS_Exc_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PtfmSgF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3696,24 +4313,24 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_UnPackParam SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3870,12 +4487,6 @@ SUBROUTINE WAMIT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackInput' @@ -4101,8 +4712,10 @@ SUBROUTINE WAMIT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT_PackOutput @@ -4119,12 +4732,6 @@ SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4192,15 +4799,10 @@ SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT_UnPackOutput @@ -4279,8 +4881,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -4295,6 +4897,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT_Input_ExtrapInterp1 @@ -4326,8 +4930,9 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp2' @@ -4349,6 +4954,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT_Input_ExtrapInterp2 @@ -4428,12 +5035,12 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4446,15 +5053,15 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE WAMIT_Output_ExtrapInterp1 @@ -4485,13 +5092,14 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4510,16 +5118,16 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE WAMIT_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Waves.f90 b/modules/hydrodyn/src/Waves.f90 index 75b4918af9..6fb35e3494 100644 --- a/modules/hydrodyn/src/Waves.f90 +++ b/modules/hydrodyn/src/Waves.f90 @@ -26,6 +26,7 @@ MODULE Waves USE UserWaves USE NWTC_Library USE NWTC_FFTPACK + USE NWTC_RandomNumber IMPLICIT NONE @@ -101,35 +102,28 @@ FUNCTION WavePkShpDefault ( Hs, Tp ) END FUNCTION WavePkShpDefault !======================================================================= - FUNCTION BoxMuller ( NDAmp, Phase ) - + FUNCTION BoxMuller ( RNGType, NDAmp, Phase ) ! This FUNCTION uses the Box-Muller method to turn two uniformly ! distributed randoms into two unit normal randoms, which are ! returned as real and imaginary components. - - - IMPLICIT NONE - - - ! Passed Variables: + IMPLICIT NONE COMPLEX(SiKi) :: BoxMuller ! This function - REAL(SiKi), INTENT(IN ), OPTIONAL :: Phase ! Optional phase to override random phase (radians) - - LOGICAL, INTENT(IN ) :: NDAmp ! Flag for normally-distributed amplitudes + ! Passed Variables: + INTEGER, INTENT(IN) :: RNGType + LOGICAL, INTENT(IN) :: NDAmp ! Flag for normally-distributed amplitudes + REAL(SiKi), INTENT(IN), OPTIONAL :: Phase ! Optional phase to override random phase (radians) ! Local Variables: REAL(SiKi) :: C1 ! Intermediate variable REAL(SiKi) :: C2 ! Intermediate variable - REAL(SiKi) :: U1 ! First uniformly distributed random - REAL(SiKi) :: U2 ! Second uniformly distributed random - - + REAL(SiKi) :: U1(1) ! First uniformly distributed random + REAL(SiKi) :: U2(1) ! Second uniformly distributed random ! Compute the two uniformly distributed randoms: ! NOTE: The first random, U1, cannot be zero else the LOG() function @@ -137,16 +131,15 @@ FUNCTION BoxMuller ( NDAmp, Phase ) ! second random, U2. U1 = 0.0 - DO WHILE ( U1 == 0.0 ) - CALL RANDOM_NUMBER(U1) + DO WHILE ( U1(1) == 0.0 ) + CALL UniformRandomNumbers(RNGType, U1) END DO - CALL RANDOM_NUMBER(U2) - - + CALL UniformRandomNumbers(RNGType, U2) + ! Compute intermediate variables: IF ( NDAmp ) THEN ! Normally-distributed amplitudes - C1 = SQRT( -2.0*LOG(U1) ) + C1 = SQRT( -2.0*LOG(U1(1)) ) ELSE ! Constant amplitudes (ignore U1); therefore, C1 = SQRT( 2.0 ) = MEAN( SQRT( -2.0*LOG(U1) ) for a uniform distribution of U1 between 0 and 1 C1 = SQRT( 2.0 ) END IF @@ -154,16 +147,13 @@ FUNCTION BoxMuller ( NDAmp, Phase ) IF ( PRESENT( Phase ) ) THEN ! Specified phase to replace random phase (ignore U2) C2 = Phase ELSE ! Uniformly-distributed phase - C2 = TwoPi*U2 + C2 = TwoPi*U2(1) END IF - ! Compute the unit normal randoms: BoxMuller = CMPLX( C1*COS(C2), C1*SIN(C2) ) - - RETURN END FUNCTION BoxMuller !======================================================================= @@ -582,7 +572,8 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ALLOCATE ( InitOut%WaveTime (0:InitOut%NStepWave ) , STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveTime.', ErrStat,ErrMsg,'StillWaterWaves_Init') - + ALLOCATE ( InitOut%WaveElev0 (0:InitOut%NStepWave ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev0.', ErrStat,ErrMsg,'StillWaterWaves_Init') ALLOCATE ( InitOut%WaveElevC0 (2, 0:InitOut%NStepWave2 ) , STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC0.',ErrStat,ErrMsg,'StillWaterWaves_Init') @@ -618,6 +609,7 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) InitOut%WaveDOmega = 0.0 InitOut%WaveTime = (/ 0.0_DbKi, 1.0_DbKi, 2.0_DbKi /) ! We must have at least two different time steps in the interpolation + InitOut%WaveElev0 = 0.0 InitOut%WaveElevC0 = 0.0 InitOut%WaveElev = 0.0 InitOut%PWaveDynP0 = 0.0 @@ -680,7 +672,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Local Variables COMPLEX(SiKi), PARAMETER :: ImagNmbr = (0.0,1.0) ! The imaginary number, SQRT(-1.0) COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) - REAL(SiKi), ALLOCATABLE :: WaveElev0 (:) ! Instantaneous elevation of incident waves at the platform reference point (meters) + ! REAL(SiKi), ALLOCATABLE :: WaveElev0 (:) ! Instantaneous elevation of incident waves at the platform reference point (meters) !COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiPz0 (:,:) ! Partial derivative of WaveAccC0Hxi(:) with respect to zi at zi = 0 (1/s^2) !COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiPz0 (:,:) ! Partial derivative of WaveAccC0Hyi(:) with respect to zi at zi = 0 (1/s^2) !COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VPz0 (:,:) ! Partial derivative of WaveAccC0V (:) with respect to zi at zi = 0 (1/s^2) @@ -712,8 +704,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) !UNUSED: !REAL(SiKi), PARAMETER :: n_Massel = 3.0 ! Factor used to the scale the peak spectral frequency in order to find the cut-off frequency based on the suggestion in: Massel, S. R., Ocean Surface Waves: Their Physics and Prediction, Advanced Series on Ocean Engineering - Vol. 11, World Scientific Publishing, Singapore - New Jersey - London - Hong Kong, 1996. This reference recommends n_Massel > 3.0 (higher for higher-order wave kinemetics); the ">" designation is accounted for by checking if ( Omega > OmegaCutOff ). REAL(SiKi) :: Omega ! Wave frequency (rad/s) !UNUSED: !REAL(SiKi) :: OmegaCutOff ! Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) - REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) - REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) +!UNUSED: ! REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) +!UNUSED: ! REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) @@ -800,8 +792,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Variables for error handling INTEGER(IntKi) :: ErrStatTmp !< Temporary error status - CHARACTER(1024) :: ErrMsgTmp !< Temporary error message - CHARACTER(1024) :: ErrMsgTmp2 !< Another temporary error message + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message + CHARACTER(ErrMsgLen) :: ErrMsgTmp2 !< Another temporary error message @@ -1097,7 +1089,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) !ALLOCATE ( PWaveAccC0VPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ALLOCATE ( WaveElev0 (0:InitOut%NStepWave-1 ), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveElev0 (0:InitOut%NStepWave ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElev0.', ErrStat,ErrMsg,'VariousWaves_Init') ALLOCATE ( InitOut%WaveElev (0:InitOut%NStepWave,InitInp%NWaveElev ), STAT=ErrStatTmp ) @@ -1497,7 +1489,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) IF ( ( I == 0 ) .OR. ( I == InitOut%NStepWave2 ) ) THEN ! .TRUE. if ( Omega == 0.0 ) or ( Omega == NStepWave2*WaveDOmega (= WaveOmegaMax) ) WGNC = (0.0,0.0) ELSEIF ( InitInp%WaveMod == 10 ) THEN ! .TRUE. for plane progressive (regular) waves with a specified phase - WGNC = BoxMuller ( InitInp%WaveNDAmp, InitInp%WavePhase ) + WGNC = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp, InitInp%WavePhase ) ! This scaling of WGNC is used to ensure that the Box-Muller method is only providing a random phase, ! not a magnitude change, at the frequency of the plane progressive wave. The SQRT(2.0) is used to ! ensure that the time series WGN process has unit variance (i.e. sinusoidal with amplitude SQRT(2.0)). @@ -1506,7 +1498,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! 0.0 in the Box-Muller method. IF ( ( I == I_WaveTp ) ) WGNC = WGNC*( SQRT(2.0)/ABS(WGNC) ) ELSE ! All other Omega - WGNC = BoxMuller ( InitInp%WaveNDAmp ) + WGNC = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp ) ! This scaling of WGNC is used to ensure that the Box-Muller method is only providing a random phase, ! not a magnitude change, at the frequency of the plane progressive wave. The SQRT(2.0) is used to ! ensure that the time series WGN process has unit variance (i.e. sinusoidal with amplitude SQRT(2.0)). @@ -1627,7 +1619,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) DO I = 1,WvSpreadFreqPerDir ! Populate the array with random numbers - CALL RANDOM_NUMBER(WvSpreadThetaIdx) + CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) DO J = 1, InitOut%WaveNDir @@ -1646,7 +1638,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ENDDO ENDDO ! Filling last value since it is not reached by the loop above - CALL RANDOM_NUMBER(WvSpreadThetaIdx) + CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) InitOut%WaveDirArr(K) = WvTheta( LastInd ) @@ -1772,7 +1764,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) END IF ! We'll need the following for wave stretching once we implement it. - CALL ApplyFFT_cx ( WaveElev0 (:), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,'VariousWaves_Init') IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -2022,7 +2014,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) InitOut%PWaveDynP0(InitOut%NStepWave,: ) = InitOut%PWaveDynP0(0,: ) InitOut%PWaveVel0 (InitOut%NStepWave,:,:) = InitOut%PWaveVel0 (0,:,:) InitOut%PWaveAcc0 (InitOut%NStepWave,:,:) = InitOut%PWaveAcc0 (0,:,:) - + InitOut%WaveElev0 (InitOut%NStepWave) = InitOut%WaveElev0 (0 ) @@ -2048,8 +2040,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStatLcl, ! Zero out the temporary array. tmpComplexArr = CMPLX(0.0_SiKi,0.0_SiKi) - ! Loop through the positive frequency components (including zero). Skip the last point since that is zero by definition. - DO I = 0,InitOut%NStepWave2-1 + ! Loop through the positive frequency components (including zero). + DO I = 0,InitOut%NStepWave2 Omega = I* InitOut%WaveDOmega WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) @@ -2102,7 +2094,7 @@ SUBROUTINE CleanUp( ) IF (ALLOCATED( WaveAccC0V )) DEALLOCATE( WaveAccC0V, STAT=ErrStatTmp) IF (ALLOCATED( WaveDynP0B )) DEALLOCATE( WaveDynP0B, STAT=ErrStatTmp) IF (ALLOCATED( WaveDynPC0 )) DEALLOCATE( WaveDynPC0, STAT=ErrStatTmp) - IF (ALLOCATED( WaveElev0 )) DEALLOCATE( WaveElev0, STAT=ErrStatTmp) + ! IF (ALLOCATED( WaveElev0 )) DEALLOCATE( WaveElev0, STAT=ErrStatTmp) IF (ALLOCATED( WaveElevC )) DEALLOCATE( WaveElevC, STAT=ErrStatTmp) IF (ALLOCATED( WaveVel0Hxi )) DEALLOCATE( WaveVel0Hxi, STAT=ErrStatTmp) IF (ALLOCATED( WaveVel0Hyi )) DEALLOCATE( WaveVel0Hyi, STAT=ErrStatTmp) @@ -2153,7 +2145,7 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Local Variables: INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for processing - CHARACTER(1024) :: ErrMsgTmp ! Temporary error message for procesing + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for procesing ! REAL(ReKi), ALLOCATABLE :: tmpWaveKinzi(:) ! TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using @@ -2172,8 +2164,9 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL NWTC_Init( ) - - + ! Initialize the pRNG + CALL RandNum_Init(InitInp%RNG, ErrStat, ErrMsg) + IF ( ErrStat >= AbortErrLev ) RETURN ! Define initialization-routine output here: @@ -2187,7 +2180,8 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! subroutine calls as necessary. InitOut%WaveDirMin = InitInp%WaveDir InitOut%WaveDirMax = InitInp%WaveDir - + InitOut%WaveDir = InitInp%WaveDir ! Not sure why there are so many copies of this variable, but InitOut%WaveDir must be set, and isn't in all cases otherwise. + ! Initialize the variables associated with the incident wave: diff --git a/modules/hydrodyn/src/Waves.txt b/modules/hydrodyn/src/Waves.txt index e5aec60ead..366067469c 100644 --- a/modules/hydrodyn/src/Waves.txt +++ b/modules/hydrodyn/src/Waves.txt @@ -59,6 +59,7 @@ typedef ^ ^ SiKi CurrVxi typedef ^ ^ SiKi CurrVyi {:} - - "yi-component of the current velocity at elevation i" (m/s) typedef ^ ^ SiKi PCurrVxiPz0 - - - "xi-component of the partial derivative of the current velocity at elevation near mean sea level" (m/s) typedef ^ ^ SiKi PCurrVyiPz0 - - - "yi-component of the partial derivative of the current velocity at elevation near mean sea level" (m/s) +typedef ^ ^ NWTC_RandomNumber_ParameterType RNG - - - "Parameters for the pseudo random number generator" - # Define outputs from the initialization routine here: @@ -79,6 +80,7 @@ typedef ^ ^ SiKi PWaveAcc0 typedef ^ ^ SiKi WaveVel {:}{:}{:} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi PWaveVel0 {:}{:}{:} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveElev {:}{:} - - "Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output" (meters) +typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi 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) diff --git a/modules/hydrodyn/src/Waves2.f90 b/modules/hydrodyn/src/Waves2.f90 index 33e92f807a..97ea03a202 100644 --- a/modules/hydrodyn/src/Waves2.f90 +++ b/modules/hydrodyn/src/Waves2.f90 @@ -46,8 +46,6 @@ MODULE Waves2 ! INTEGER(IntKi), PARAMETER :: DataFormatID = 1 !< Update this value if the data types change (used in Waves2_Pack) TYPE(ProgDesc), PARAMETER :: Waves2_ProgDesc = ProgDesc( 'Waves2', '', '' ) !< This holds the name of the program, version info, and date. - !! It is used by the DispNVD routine in the library and as header - !! information in output files. REAL(DbKi), PARAMETER, PRIVATE :: OnePlusEps = 1.0 + EPSILON(OnePlusEps) ! The number slighty greater than unity in the precision of DbKi. @@ -223,9 +221,6 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Initialize the NWTC Subroutine Library and display the information about this module. CALL NWTC_Init( ) - !CALL DispNVD( Waves2_ProgDesc ) - - !----------------------------------------------------------------------------- diff --git a/modules/hydrodyn/src/Waves2.txt b/modules/hydrodyn/src/Waves2.txt index 0ecbda2356..71aa3c56ad 100644 --- a/modules/hydrodyn/src/Waves2.txt +++ b/modules/hydrodyn/src/Waves2.txt @@ -54,7 +54,7 @@ typedef ^ ^ SiKi WvHiCOffD typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ CHARACTER(10) OutList {18} - - "This should really be dimensioned with MaxOutPts" - +typedef ^ ^ CHARACTER(ChanLen) OutList {18} - - "This should really be dimensioned with MaxOutPts" - typedef ^ ^ LOGICAL OutAll - - - "" - typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER NumOutAll - - - "" - @@ -62,8 +62,8 @@ typedef ^ ^ INTEGER NumOutAll # Define outputs from the initialization routine here: # -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "" - -typedef ^ ^ CHARACTER(10) WriteOutputUnt {:} - - "" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - typedef ^ ^ SiKi WaveElevSeries2 {:}{:} - - "" (m) # "Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY." (m) typedef ^ ^ SiKi WaveAcc2D {:}{:}{:} - - "" (m/s^2) @@ -137,7 +137,7 @@ typedef ^ ^ INTEGER NumOuts typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - diff --git a/modules/hydrodyn/src/Waves2_Output.f90 b/modules/hydrodyn/src/Waves2_Output.f90 index c4d72fcdd0..817ebc7272 100644 --- a/modules/hydrodyn/src/Waves2_Output.f90 +++ b/modules/hydrodyn/src/Waves2_Output.f90 @@ -231,7 +231,7 @@ SUBROUTINE Wvs2OUT_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) ! CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. ! CHARACTER(200) :: Frmt ! a string to hold a format statement - CHARACTER(1024) :: ErrMsgTmp ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary Error status INTEGER(IntKi) :: ErrStatTmp ! Temporary Error message @@ -301,8 +301,8 @@ FUNCTION GetWaves2Channels ( NUserOutputs, UserOutputs, OutList, foundMask, !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(10), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(10), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched Waves2 output channels. + CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched Waves2 output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -315,7 +315,7 @@ FUNCTION GetWaves2Channels ( NUserOutputs, UserOutputs, OutList, foundMask, INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. ! LOGICAL :: InvalidOutput(MaxWaves2Outputs) ! This array determines if the output channel is valid for this configuration LOGICAL :: CheckOutListAgain @@ -416,20 +416,20 @@ SUBROUTINE Wvs2OUT_ChkOutLst( OutList, y, p, ErrStat, ErrMsg ) TYPE(Waves2_OutputType), INTENT( INOUT ) :: y ! This module's internal data TYPE(Waves2_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the Waves2 platform module - CHARACTER(10), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. + CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! Local variables. - CHARACTER(1024) :: ErrMsgTmp ! Temporary error message + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message INTEGER(IntKi) :: ErrStatTmp ! Temporary error status INTEGER :: I ! Generic loop-counting index. ! INTEGER :: J ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays - CHARACTER(10) :: OutListTmp ! A string to temporarily hold OutList(I). + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 index 66297b84be..affe3fdc41 100644 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ b/modules/hydrodyn/src/Waves2_Types.f90 @@ -62,7 +62,7 @@ MODULE Waves2_Types REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - CHARACTER(10) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] + CHARACTER(ChanLen) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] LOGICAL :: OutAll !< [-] INTEGER(IntKi) :: NumOuts !< [-] INTEGER(IntKi) :: NumOutAll !< [-] @@ -70,8 +70,8 @@ MODULE Waves2_Types ! ======================= ! ========= Waves2_InitOutputType ======= TYPE, PUBLIC :: Waves2_InitOutputType - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries2 !< [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D !< [(m/s^2)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D !< [(N/m^2)] @@ -127,7 +127,7 @@ MODULE Waves2_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE Waves2_ParameterType ! ======================= @@ -460,24 +460,24 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -488,8 +488,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -504,8 +506,12 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -517,11 +523,13 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -532,8 +540,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevxi))-1 ) = PACK(InData%WaveElevxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevxi) + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -545,8 +555,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevyi))-1 ) = PACK(InData%WaveElevyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevyi) + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -561,11 +573,15 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -576,8 +592,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinxi))-1 ) = PACK(InData%WaveKinxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinxi) + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -589,8 +607,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinyi))-1 ) = PACK(InData%WaveKinyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinyi) + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -602,33 +622,35 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvDiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvSumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackInitInput SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -644,12 +666,6 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -666,24 +682,24 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveStMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -697,15 +713,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 @@ -723,15 +734,12 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -746,18 +754,13 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -771,15 +774,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevxi)>0) OutData%WaveElevxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated Int_Xferred = Int_Xferred + 1 @@ -794,15 +792,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevyi)>0) OutData%WaveElevyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 @@ -820,18 +813,15 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NWaveKin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -845,15 +835,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinxi)>0) OutData%WaveKinxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated Int_Xferred = Int_Xferred + 1 @@ -868,15 +853,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinyi)>0) OutData%WaveKinyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 @@ -891,49 +871,37 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) - END IF - OutData%WvDiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOffD = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackInitInput SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1380,12 +1348,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1397,12 +1365,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1417,8 +1385,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries2))-1 ) = PACK(InData%WaveElevSeries2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries2) + DO i2 = LBOUND(InData%WaveElevSeries2,2), UBOUND(InData%WaveElevSeries2,2) + DO i1 = LBOUND(InData%WaveElevSeries2,1), UBOUND(InData%WaveElevSeries2,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1436,8 +1408,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2D))-1 ) = PACK(InData%WaveAcc2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2D) + DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) + DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) + DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1452,8 +1430,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2D))-1 ) = PACK(InData%WaveDynP2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2D) + DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) + DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1471,8 +1453,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2S))-1 ) = PACK(InData%WaveAcc2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2S) + DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) + DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) + DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1487,8 +1475,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2S))-1 ) = PACK(InData%WaveDynP2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2S) + DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) + DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1506,8 +1498,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2D))-1 ) = PACK(InData%WaveVel2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2D) + DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) + DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) + DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1525,8 +1523,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2S))-1 ) = PACK(InData%WaveVel2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2S) + DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) + DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) + DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1544,8 +1548,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2D0))-1 ) = PACK(InData%WaveAcc2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2D0) + DO i3 = LBOUND(InData%WaveAcc2D0,3), UBOUND(InData%WaveAcc2D0,3) + DO i2 = LBOUND(InData%WaveAcc2D0,2), UBOUND(InData%WaveAcc2D0,2) + DO i1 = LBOUND(InData%WaveAcc2D0,1), UBOUND(InData%WaveAcc2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1560,8 +1570,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2D0))-1 ) = PACK(InData%WaveDynP2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2D0) + DO i2 = LBOUND(InData%WaveDynP2D0,2), UBOUND(InData%WaveDynP2D0,2) + DO i1 = LBOUND(InData%WaveDynP2D0,1), UBOUND(InData%WaveDynP2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1579,8 +1593,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2S0))-1 ) = PACK(InData%WaveAcc2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2S0) + DO i3 = LBOUND(InData%WaveAcc2S0,3), UBOUND(InData%WaveAcc2S0,3) + DO i2 = LBOUND(InData%WaveAcc2S0,2), UBOUND(InData%WaveAcc2S0,2) + DO i1 = LBOUND(InData%WaveAcc2S0,1), UBOUND(InData%WaveAcc2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1595,8 +1615,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2S0))-1 ) = PACK(InData%WaveDynP2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2S0) + DO i2 = LBOUND(InData%WaveDynP2S0,2), UBOUND(InData%WaveDynP2S0,2) + DO i1 = LBOUND(InData%WaveDynP2S0,1), UBOUND(InData%WaveDynP2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1614,8 +1638,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2D0))-1 ) = PACK(InData%WaveVel2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2D0) + DO i3 = LBOUND(InData%WaveVel2D0,3), UBOUND(InData%WaveVel2D0,3) + DO i2 = LBOUND(InData%WaveVel2D0,2), UBOUND(InData%WaveVel2D0,2) + DO i1 = LBOUND(InData%WaveVel2D0,1), UBOUND(InData%WaveVel2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1633,8 +1663,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2S0))-1 ) = PACK(InData%WaveVel2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2S0) + DO i3 = LBOUND(InData%WaveVel2S0,3), UBOUND(InData%WaveVel2S0,3) + DO i2 = LBOUND(InData%WaveVel2S0,2), UBOUND(InData%WaveVel2S0,2) + DO i1 = LBOUND(InData%WaveVel2S0,1), UBOUND(InData%WaveVel2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE Waves2_PackInitOutput @@ -1651,12 +1687,6 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1686,19 +1716,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1713,19 +1736,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries2 not allocated Int_Xferred = Int_Xferred + 1 @@ -1743,15 +1759,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries2)>0) OutData%WaveElevSeries2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries2,2), UBOUND(OutData%WaveElevSeries2,2) + DO i1 = LBOUND(OutData%WaveElevSeries2,1), UBOUND(OutData%WaveElevSeries2,1) + OutData%WaveElevSeries2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1772,15 +1785,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2D)>0) OutData%WaveAcc2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2D))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2D) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) + DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) + DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) + OutData%WaveAcc2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1798,15 +1810,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2D)>0) OutData%WaveDynP2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2D))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) + DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) + OutData%WaveDynP2D(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1827,15 +1836,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2S)>0) OutData%WaveAcc2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2S))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) + DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) + DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) + OutData%WaveAcc2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1853,15 +1861,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2S)>0) OutData%WaveDynP2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2S))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2S) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) + DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) + OutData%WaveDynP2S(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1882,15 +1887,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2D)>0) OutData%WaveVel2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2D))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2D) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) + DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) + DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) + OutData%WaveVel2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1911,15 +1915,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2S)>0) OutData%WaveVel2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2S))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) + DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) + DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) + OutData%WaveVel2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1940,15 +1943,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2D0)>0) OutData%WaveAcc2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2D0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2D0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2D0,3), UBOUND(OutData%WaveAcc2D0,3) + DO i2 = LBOUND(OutData%WaveAcc2D0,2), UBOUND(OutData%WaveAcc2D0,2) + DO i1 = LBOUND(OutData%WaveAcc2D0,1), UBOUND(OutData%WaveAcc2D0,1) + OutData%WaveAcc2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1966,15 +1968,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2D0)>0) OutData%WaveDynP2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2D0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2D0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2D0,2), UBOUND(OutData%WaveDynP2D0,2) + DO i1 = LBOUND(OutData%WaveDynP2D0,1), UBOUND(OutData%WaveDynP2D0,1) + OutData%WaveDynP2D0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1995,15 +1994,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2S0)>0) OutData%WaveAcc2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2S0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2S0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2S0,3), UBOUND(OutData%WaveAcc2S0,3) + DO i2 = LBOUND(OutData%WaveAcc2S0,2), UBOUND(OutData%WaveAcc2S0,2) + DO i1 = LBOUND(OutData%WaveAcc2S0,1), UBOUND(OutData%WaveAcc2S0,1) + OutData%WaveAcc2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2021,15 +2019,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2S0)>0) OutData%WaveDynP2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2S0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2S0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2S0,2), UBOUND(OutData%WaveDynP2S0,2) + DO i1 = LBOUND(OutData%WaveDynP2S0,1), UBOUND(OutData%WaveDynP2S0,1) + OutData%WaveDynP2S0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2050,15 +2045,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2D0)>0) OutData%WaveVel2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2D0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2D0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2D0,3), UBOUND(OutData%WaveVel2D0,3) + DO i2 = LBOUND(OutData%WaveVel2D0,2), UBOUND(OutData%WaveVel2D0,2) + DO i1 = LBOUND(OutData%WaveVel2D0,1), UBOUND(OutData%WaveVel2D0,1) + OutData%WaveVel2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2079,15 +2073,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2S0)>0) OutData%WaveVel2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2S0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2S0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2S0,3), UBOUND(OutData%WaveVel2S0,3) + DO i2 = LBOUND(OutData%WaveVel2S0,2), UBOUND(OutData%WaveVel2S0,2) + DO i1 = LBOUND(OutData%WaveVel2S0,1), UBOUND(OutData%WaveVel2S0,1) + OutData%WaveVel2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE Waves2_UnPackInitOutput @@ -2182,8 +2175,8 @@ SUBROUTINE Waves2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackContState SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2199,12 +2192,6 @@ SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackContState' @@ -2218,8 +2205,8 @@ SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackContState SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2313,8 +2300,8 @@ SUBROUTINE Waves2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackDiscState SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2330,12 +2317,6 @@ SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackDiscState' @@ -2349,8 +2330,8 @@ SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackDiscState SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2444,8 +2425,8 @@ SUBROUTINE Waves2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackConstrState SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2461,12 +2442,6 @@ SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackConstrState' @@ -2480,8 +2455,8 @@ SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackConstrState SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2575,8 +2550,8 @@ SUBROUTINE Waves2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackOtherState SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2592,12 +2567,6 @@ SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOtherState' @@ -2611,8 +2580,8 @@ SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackOtherState SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2706,8 +2675,8 @@ SUBROUTINE Waves2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackMisc SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2723,12 +2692,6 @@ SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackMisc' @@ -2742,8 +2705,8 @@ SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackMisc SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2949,18 +2912,18 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvDiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvSumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2971,8 +2934,10 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2987,8 +2952,12 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev2))-1 ) = PACK(InData%WaveElev2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev2) + DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) + DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) + ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3031,24 +3000,24 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackParam SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3064,12 +3033,6 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3085,18 +3048,18 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WvDiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3110,15 +3073,10 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated Int_Xferred = Int_Xferred + 1 @@ -3136,15 +3094,12 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev2)>0) OutData%WaveElev2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) + DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) + OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 @@ -3202,24 +3157,24 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackParam SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3313,8 +3268,8 @@ SUBROUTINE Waves2_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackInput SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3330,12 +3285,6 @@ SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInput' @@ -3349,8 +3298,8 @@ SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackInput SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -3473,8 +3422,10 @@ SUBROUTINE Waves2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Waves2_PackOutput @@ -3491,12 +3442,6 @@ SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3524,15 +3469,10 @@ SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Waves2_UnPackOutput @@ -3611,8 +3551,8 @@ SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3627,8 +3567,10 @@ SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Waves2_Input_ExtrapInterp1 @@ -3658,8 +3600,9 @@ SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp2' @@ -3681,9 +3624,11 @@ SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Waves2_Input_ExtrapInterp2 @@ -3761,12 +3706,12 @@ SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -3779,13 +3724,13 @@ SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Waves2_Output_ExtrapInterp1 @@ -3816,13 +3761,14 @@ SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -3841,14 +3787,14 @@ SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Waves2_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 index d65b503d86..9b98fdc949 100644 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ b/modules/hydrodyn/src/Waves_Types.f90 @@ -76,6 +76,7 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< yi-component of the current velocity at elevation i [(m/s)] REAL(SiKi) :: PCurrVxiPz0 !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] REAL(SiKi) :: PCurrVyiPz0 !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + TYPE(NWTC_RandomNumber_ParameterType) :: RNG !< Parameters for the pseudo random number generator [-] END TYPE Waves_InitInputType ! ======================= ! ========= Waves_InitOutputType ======= @@ -96,6 +97,7 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveVel0 !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: 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)] @@ -298,6 +300,9 @@ SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ENDIF DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 + CALL NWTC_Library_Copynwtc_randomnumber_parametertype( SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Waves_CopyInitInput SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -333,6 +338,7 @@ 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 ) END SUBROUTINE Waves_DestroyInitInput SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -443,6 +449,24 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END IF Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! RNG: size of buffers for each call to pack subtype + CALL NWTC_Library_Packnwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! RNG + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! RNG + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! RNG + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -470,76 +494,78 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%WvKinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WriteWvKin , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirSpread - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirRange - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveHs - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WaveModChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveNDAmp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WavePhase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WavePkShp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WavePkShpChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WaveSeed))-1 ) = PACK(InData%WaveSeed,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WaveSeed) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveTp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%WvKinFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteWvKin, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveDirMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirSpread + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirRange + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveHs + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WaveModChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePhase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePkShp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WavePkShpChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) + IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveTp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -550,8 +576,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevxi))-1 ) = PACK(InData%WaveElevxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevxi) + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -563,8 +591,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevyi))-1 ) = PACK(InData%WaveElevyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevyi) + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -579,11 +609,15 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -594,8 +628,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinxi))-1 ) = PACK(InData%WaveKinxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinxi) + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -607,8 +643,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinyi))-1 ) = PACK(InData%WaveKinyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinyi) + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -620,8 +658,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -633,8 +673,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVxi))-1 ) = PACK(InData%CurrVxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVxi) + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -646,13 +688,43 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVyi))-1 ) = PACK(InData%CurrVyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVyi) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 + CALL NWTC_Library_Packnwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE Waves_PackInitInput SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -668,12 +740,6 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -690,85 +756,80 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%WvKinFile) - OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WriteWvKin = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOff = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirSpread = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirRange = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveHs = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WaveModChr) - OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveNDAmp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WavePhase = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WavePkShp = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WavePkShpChr) - OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%WvKinFile) + OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WriteWvKin = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteWvKin) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WaveModChr) + OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) + Int_Xferred = Int_Xferred + 1 + OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WavePkShpChr) + OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%WaveSeed,1) i1_u = UBOUND(OutData%WaveSeed,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WaveSeed = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WaveSeed))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WaveSeed) - DEALLOCATE(mask1) - OutData%WaveStMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTp = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) + OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -782,15 +843,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevxi)>0) OutData%WaveElevxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated Int_Xferred = Int_Xferred + 1 @@ -805,15 +861,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevyi)>0) OutData%WaveElevyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 @@ -831,18 +882,15 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NWaveKin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -856,15 +904,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinxi)>0) OutData%WaveKinxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated Int_Xferred = Int_Xferred + 1 @@ -879,15 +922,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinyi)>0) OutData%WaveKinyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 @@ -902,15 +940,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated Int_Xferred = Int_Xferred + 1 @@ -925,15 +958,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVxi)>0) OutData%CurrVxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated Int_Xferred = Int_Xferred + 1 @@ -948,20 +976,55 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVyi)>0) OutData%CurrVyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVyi) - DEALLOCATE(mask1) - END IF - OutData%PCurrVxiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpacknwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE Waves_UnPackInitInput SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1131,6 +1194,18 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) + i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev0)) THEN + ALLOCATE(DstInitOutputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 +ENDIF IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) @@ -1216,6 +1291,9 @@ SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitOutputData%WaveElev)) THEN DEALLOCATE(InitOutputData%WaveElev) ENDIF +IF (ALLOCATED(InitOutputData%WaveElev0)) THEN + DEALLOCATE(InitOutputData%WaveElev0) +ENDIF IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF @@ -1318,6 +1396,11 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no + IF ( ALLOCATED(InData%WaveElev0) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 + END IF Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no IF ( ALLOCATED(InData%WaveElevSeries) ) THEN Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension @@ -1377,8 +1460,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1390,21 +1477,23 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1415,8 +1504,10 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1431,8 +1522,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveDynP0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveDynP0))-1 ) = PACK(InData%PWaveDynP0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveDynP0) + DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) + DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1447,8 +1542,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1466,8 +1565,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1485,8 +1590,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveAcc0))-1 ) = PACK(InData%PWaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveAcc0) + DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) + DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) + DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1504,8 +1615,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1523,8 +1640,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveVel0))-1 ) = PACK(InData%PWaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveVel0) + DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) + DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) + DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) + ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1539,8 +1662,27 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1555,8 +1697,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries))-1 ) = PACK(InData%WaveElevSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries) + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1568,11 +1714,13 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1586,15 +1734,19 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackInitOutput SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1610,12 +1762,6 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1648,15 +1794,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 @@ -1671,28 +1814,23 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) - END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1706,15 +1844,10 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1732,15 +1865,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PWaveDynP0)>0) OutData%PWaveDynP0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveDynP0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveDynP0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) + DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) + OutData%PWaveDynP0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -1758,15 +1888,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 @@ -1787,15 +1914,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1816,15 +1942,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PWaveAcc0)>0) OutData%PWaveAcc0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveAcc0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) + DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) + DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) + OutData%PWaveAcc0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -1845,15 +1970,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1874,15 +1998,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PWaveVel0)>0) OutData%PWaveVel0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveVel0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) + DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) + DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) + OutData%PWaveVel0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 @@ -1900,15 +2023,30 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 @@ -1926,15 +2064,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries)>0) OutData%WaveElevSeries = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -1949,18 +2084,13 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1977,22 +2107,19 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) - END IF - OutData%RhoXg = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackInitOutput SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2086,8 +2213,8 @@ SUBROUTINE Waves_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackContState SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2103,12 +2230,6 @@ SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackContState' @@ -2122,8 +2243,8 @@ SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackContState SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2217,8 +2338,8 @@ SUBROUTINE Waves_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackDiscState SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2234,12 +2355,6 @@ SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackDiscState' @@ -2253,8 +2368,8 @@ SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackDiscState SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2348,8 +2463,8 @@ SUBROUTINE Waves_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackConstrState SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2365,12 +2480,6 @@ SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackConstrState' @@ -2384,8 +2493,8 @@ SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackConstrState SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2479,8 +2588,8 @@ SUBROUTINE Waves_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackOtherState SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2496,12 +2605,6 @@ SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOtherState' @@ -2515,8 +2618,8 @@ SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackOtherState SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2610,8 +2713,8 @@ SUBROUTINE Waves_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackMisc SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2627,12 +2730,6 @@ SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackMisc' @@ -2646,8 +2743,8 @@ SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackMisc SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2749,16 +2846,16 @@ SUBROUTINE Waves_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackParam SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2774,12 +2871,6 @@ SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackParam' @@ -2793,16 +2884,16 @@ SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackParam SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -2896,8 +2987,8 @@ SUBROUTINE Waves_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackInput SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2913,12 +3004,6 @@ SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInput' @@ -2932,8 +3017,8 @@ SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackInput SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -3027,8 +3112,8 @@ SUBROUTINE Waves_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackOutput SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3044,12 +3129,6 @@ SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOutput' @@ -3063,8 +3142,8 @@ SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOutput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackOutput @@ -3142,8 +3221,8 @@ SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3158,8 +3237,10 @@ SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Waves_Input_ExtrapInterp1 @@ -3189,8 +3270,9 @@ SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp2' @@ -3212,9 +3294,11 @@ SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Waves_Input_ExtrapInterp2 @@ -3292,8 +3376,8 @@ SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3308,8 +3392,10 @@ SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor END SUBROUTINE Waves_Output_ExtrapInterp1 @@ -3339,8 +3425,9 @@ SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp2' @@ -3362,9 +3449,11 @@ SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out END SUBROUTINE Waves_Output_ExtrapInterp2 END MODULE Waves_Types diff --git a/modules/icedyn/src/IceDyn.f90 b/modules/icedyn/src/IceDyn.f90 index f3a85c5863..64ed3f375a 100644 --- a/modules/icedyn/src/IceDyn.f90 +++ b/modules/icedyn/src/IceDyn.f90 @@ -289,7 +289,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -403,7 +403,7 @@ SUBROUTINE IceD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrSt REAL(ReKi) :: Pnxt ! Pitch of the next ice tooth (m) INTEGER(IntKi) :: ErrStat2 - CHARACTER(1024) :: ErrMsg2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Initialize ErrStat @@ -1128,7 +1128,7 @@ SUBROUTINE IceD_ReadInput( InitInp, InputFileData, ErrStat, ErrMsg ) ! Local variables INTEGER :: UnIn ! Unit number for the input file - CHARACTER(1024) :: FileName ! Name of HydroDyn input file + CHARACTER(ErrMsgLen) :: FileName ! Name of HydroDyn input file INTEGER :: UnEc ! Unit number for the echo file LOGICAL, PARAMETER :: Echo = .FALSE. ! echo file for debugging diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 0f10f55850..5a676fa8b3 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -167,8 +167,8 @@ MODULE IceDyn_Types INTEGER(IntKi) :: NumOuts !< The number of output channels [-] INTEGER(IntKi) :: method !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] INTEGER(IntKi) :: TmStep !< Total time step [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: OutName !< Names of all requested output parameters [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: OutUnit !< Units of all requested output parameters [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutName !< Names of all requested output parameters [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutUnit !< Units of all requested output parameters [-] CHARACTER(1024) :: RootName !< Rootname [-] REAL(ReKi) :: tm1a !< Time for the maximum force to be reached for model 1a [s] REAL(ReKi) :: tm1b !< Time for the maximum force to be reached for model 1b [s] @@ -489,28 +489,28 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceSubModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Seed1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Seed2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLegs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceSubModel + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%h + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhow + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoi + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Seed1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Seed2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLegs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LegPosX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -521,8 +521,10 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LegPosX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LegPosX))-1 ) = PACK(InData%LegPosX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LegPosX) + DO i1 = LBOUND(InData%LegPosX,1), UBOUND(InData%LegPosX,1) + ReKiBuf(Re_Xferred) = InData%LegPosX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LegPosY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -534,8 +536,10 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LegPosY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LegPosY))-1 ) = PACK(InData%LegPosY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LegPosY) + DO i1 = LBOUND(InData%LegPosY,1), UBOUND(InData%LegPosY,1) + ReKiBuf(Re_Xferred) = InData%LegPosY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StrWd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -547,101 +551,103 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrWd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StrWd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StrWd))-1 ) = PACK(InData%StrWd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StrWd) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ag - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Qg - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rg - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%nu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%phi - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SigNm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IceStr2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miubr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varP - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrflMean - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrflSig - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IceStr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dtp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%sigf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrLim - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrRtLim - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UorD - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ll - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Lw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fdr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kic - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FspN - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StrWd,1), UBOUND(InData%StrWd,1) + ReKiBuf(Re_Xferred) = InData%StrWd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Ikm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ag + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Qg + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rg + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Tice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%nu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%phi + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SigNm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Eice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IceStr2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miubr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuDelm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varDelm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varP + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Zn1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Zn2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ZonePitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrflMean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrflSig + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IceStr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dwl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dtp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%sigf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrLim + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrRtLim + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UorD + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ll + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Lw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fdr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kic + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FspN + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackInputFile SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -657,12 +663,6 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -677,28 +677,28 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IceModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IceSubModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%h = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Seed1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Seed2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IceModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IceSubModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%h = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhow = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Seed1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Seed2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -712,15 +712,10 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LegPosX)>0) OutData%LegPosX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LegPosX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LegPosX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LegPosX,1), UBOUND(OutData%LegPosX,1) + OutData%LegPosX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosY not allocated Int_Xferred = Int_Xferred + 1 @@ -735,15 +730,10 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LegPosY)>0) OutData%LegPosY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LegPosY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LegPosY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LegPosY,1), UBOUND(OutData%LegPosY,1) + OutData%LegPosY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrWd not allocated Int_Xferred = Int_Xferred + 1 @@ -758,108 +748,103 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StrWd)>0) OutData%StrWd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StrWd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StrWd) - DEALLOCATE(mask1) - END IF - OutData%Ikm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ag = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Qg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%nu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%phi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SigNm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Eice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miubr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuDelm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varDelm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Zn1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Zn2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ZonePitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PrflMean = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PrflSig = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dtp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%sigf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrLim = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrRtLim = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UorD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ll = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Lw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fdr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kic = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FspN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%StrWd,1), UBOUND(OutData%StrWd,1) + OutData%StrWd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Ikm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ag = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Qg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%nu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%phi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SigNm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Eice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IceStr2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miubr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuDelm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varDelm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Zn1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Zn2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ZonePitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PrflMean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PrflSig = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IceStr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dwl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dtp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%sigf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrLim = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrRtLim = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UorD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ll = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Lw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fdr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kic = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FspN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackInputFile SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -965,24 +950,24 @@ SUBROUTINE IceD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LegNum - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LegNum + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 END SUBROUTINE IceD_PackInitInput SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -998,12 +983,6 @@ SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInitInput' @@ -1017,24 +996,24 @@ SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LegNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LegNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE IceD_UnPackInitInput SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1201,12 +1180,12 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1218,15 +1197,15 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numLegs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numLegs + Int_Xferred = Int_Xferred + 1 CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1270,12 +1249,6 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1303,19 +1276,12 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1330,22 +1296,15 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%numLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%numLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1481,10 +1440,10 @@ SUBROUTINE IceD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dqdt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dqdt + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackContState SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1500,12 +1459,6 @@ SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackContState' @@ -1519,10 +1472,10 @@ SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dqdt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dqdt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackContState SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1616,8 +1569,8 @@ SUBROUTINE IceD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackDiscState SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1633,12 +1586,6 @@ SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackDiscState' @@ -1652,8 +1599,8 @@ SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackDiscState SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1747,8 +1694,8 @@ SUBROUTINE IceD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackConstrState SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1764,12 +1711,6 @@ SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackConstrState' @@ -1783,8 +1724,8 @@ SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackConstrState SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1995,8 +1936,8 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceTthNo2 - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceTthNo2 + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nc) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2007,8 +1948,10 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nc,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nc)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Nc))-1 ) = PACK(InData%Nc,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Nc) + DO i1 = LBOUND(InData%Nc,1), UBOUND(InData%Nc,1) + IntKiBuf(Int_Xferred) = InData%Nc(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Psum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2020,8 +1963,10 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Psum)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Psum))-1 ) = PACK(InData%Psum,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Psum) + DO i1 = LBOUND(InData%Psum,1), UBOUND(InData%Psum,1) + ReKiBuf(Re_Xferred) = InData%Psum(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IceTthNo) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2033,17 +1978,19 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceTthNo,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IceTthNo)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IceTthNo))-1 ) = PACK(InData%IceTthNo,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IceTthNo) + DO i1 = LBOUND(InData%IceTthNo,1), UBOUND(InData%IceTthNo,1) + IntKiBuf(Int_Xferred) = InData%IceTthNo(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Beta - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tinit - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Splitf - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dxc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Beta + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tinit + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Splitf + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dxc + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%xdot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2085,8 +2032,8 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_PackOtherState SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2102,12 +2049,6 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2122,8 +2063,8 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IceTthNo2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IceTthNo2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nc not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2137,15 +2078,10 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Nc)>0) OutData%Nc = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Nc))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Nc) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Nc,1), UBOUND(OutData%Nc,1) + OutData%Nc(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psum not allocated Int_Xferred = Int_Xferred + 1 @@ -2160,15 +2096,10 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Psum)>0) OutData%Psum = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Psum))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Psum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Psum,1), UBOUND(OutData%Psum,1) + OutData%Psum(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceTthNo not allocated Int_Xferred = Int_Xferred + 1 @@ -2183,24 +2114,19 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IceTthNo)>0) OutData%IceTthNo = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IceTthNo))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IceTthNo) - DEALLOCATE(mask1) - END IF - OutData%Beta = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tinit = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Splitf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dxc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%IceTthNo,1), UBOUND(OutData%IceTthNo,1) + OutData%IceTthNo(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%Beta = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tinit = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Splitf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dxc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2257,8 +2183,8 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_UnPackOtherState SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2352,8 +2278,8 @@ SUBROUTINE IceD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_PackMisc SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2369,12 +2295,6 @@ SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackMisc' @@ -2388,8 +2308,8 @@ SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_UnPackMisc SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2778,34 +2698,34 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrWd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tolerance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%verif - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SubModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TmStep - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%h + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrWd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tolerance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Tmax + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%verif + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ModNo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SubModNo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TmStep + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutName) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2816,12 +2736,12 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutName,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) + DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) DO I = 1, LEN(InData%OutName) IntKiBuf(Int_Xferred) = ICHAR(InData%OutName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutUnit) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2833,41 +2753,41 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutUnit,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) + DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) DO I = 1, LEN(InData%OutUnit) IntKiBuf(Int_Xferred) = ICHAR(InData%OutUnit(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cstr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EiPa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kice2 - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%tm1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tm1b + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tm1c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1b + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ikm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cstr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EiPa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kice2 + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rdmFm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2878,8 +2798,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmFm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmFm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmFm))-1 ) = PACK(InData%rdmFm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmFm) + DO i1 = LBOUND(InData%rdmFm,1), UBOUND(InData%rdmFm,1) + ReKiBuf(Re_Xferred) = InData%rdmFm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmt0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2891,8 +2813,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmt0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmt0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmt0))-1 ) = PACK(InData%rdmt0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmt0) + DO i1 = LBOUND(InData%rdmt0,1), UBOUND(InData%rdmt0,1) + ReKiBuf(Re_Xferred) = InData%rdmt0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmtm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2904,8 +2828,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmtm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmtm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmtm))-1 ) = PACK(InData%rdmtm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmtm) + DO i1 = LBOUND(InData%rdmtm,1), UBOUND(InData%rdmtm,1) + ReKiBuf(Re_Xferred) = InData%rdmtm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmDm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2917,8 +2843,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmDm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmDm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmDm))-1 ) = PACK(InData%rdmDm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmDm) + DO i1 = LBOUND(InData%rdmDm,1), UBOUND(InData%rdmDm,1) + ReKiBuf(Re_Xferred) = InData%rdmDm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2930,8 +2858,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmP))-1 ) = PACK(InData%rdmP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmP) + DO i1 = LBOUND(InData%rdmP,1), UBOUND(InData%rdmP,1) + ReKiBuf(Re_Xferred) = InData%rdmP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmKi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2943,15 +2873,17 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmKi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmKi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmKi))-1 ) = PACK(InData%rdmKi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmKi) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%rdmKi,1), UBOUND(InData%rdmKi,1) + ReKiBuf(Re_Xferred) = InData%rdmKi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%ZonePitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Y0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2962,8 +2894,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y0))-1 ) = PACK(InData%Y0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y0) + DO i1 = LBOUND(InData%Y0,1), UBOUND(InData%Y0,1) + ReKiBuf(Re_Xferred) = InData%Y0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ContPrfl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2975,45 +2909,47 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ContPrfl,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ContPrfl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ContPrfl))-1 ) = PACK(InData%ContPrfl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ContPrfl) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alphaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Zr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RHbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RVbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Lbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LovR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Wri - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FdrN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Mice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fsp - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%ContPrfl,1), UBOUND(InData%ContPrfl,1) + ReKiBuf(Re_Xferred) = InData%ContPrfl(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Zn + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoi + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhow + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alphaR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dwl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Zr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RHbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RVbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Lbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LovR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Wri + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FdrN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Mice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fsp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackParam SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3029,12 +2965,6 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3049,34 +2979,34 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%h = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrWd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tolerance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%verif = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ModNo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SubModNo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TmStep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%h = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrWd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tolerance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%verif = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ModNo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SubModNo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TmStep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutName not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3090,19 +3020,12 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) + DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) DO I = 1, LEN(OutData%OutName) OutData%OutName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutUnit not allocated Int_Xferred = Int_Xferred + 1 @@ -3117,48 +3040,41 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) + DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) DO I = 1, LEN(OutData%OutUnit) OutData%OutUnit(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%tm1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tm1b = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tm1c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1b = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ikm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cstr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EiPa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kice2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%tm1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tm1b = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tm1c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1b = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ikm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cstr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EiPa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kice2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmFm not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3172,15 +3088,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmFm)>0) OutData%rdmFm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmFm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmFm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmFm,1), UBOUND(OutData%rdmFm,1) + OutData%rdmFm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmt0 not allocated Int_Xferred = Int_Xferred + 1 @@ -3195,15 +3106,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmt0)>0) OutData%rdmt0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmt0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmt0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmt0,1), UBOUND(OutData%rdmt0,1) + OutData%rdmt0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmtm not allocated Int_Xferred = Int_Xferred + 1 @@ -3218,15 +3124,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmtm)>0) OutData%rdmtm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmtm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmtm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmtm,1), UBOUND(OutData%rdmtm,1) + OutData%rdmtm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmDm not allocated Int_Xferred = Int_Xferred + 1 @@ -3241,15 +3142,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmDm)>0) OutData%rdmDm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmDm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmDm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmDm,1), UBOUND(OutData%rdmDm,1) + OutData%rdmDm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmP not allocated Int_Xferred = Int_Xferred + 1 @@ -3264,15 +3160,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmP)>0) OutData%rdmP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmP,1), UBOUND(OutData%rdmP,1) + OutData%rdmP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmKi not allocated Int_Xferred = Int_Xferred + 1 @@ -3287,22 +3178,17 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmKi)>0) OutData%rdmKi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmKi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmKi) - DEALLOCATE(mask1) - END IF - OutData%ZonePitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%rdmKi,1), UBOUND(OutData%rdmKi,1) + OutData%rdmKi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ZonePitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3316,15 +3202,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y0)>0) OutData%Y0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y0,1), UBOUND(OutData%Y0,1) + OutData%Y0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ContPrfl not allocated Int_Xferred = Int_Xferred + 1 @@ -3339,52 +3220,47 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ContPrfl)>0) OutData%ContPrfl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ContPrfl))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ContPrfl) - DEALLOCATE(mask1) - END IF - OutData%Zn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rhoi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alphaR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Zr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RHbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RVbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Lbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LovR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Wri = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FdrN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Mice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fsp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ContPrfl,1), UBOUND(OutData%ContPrfl,1) + OutData%ContPrfl(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Zn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rhoi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhow = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alphaR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dwl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Zr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RHbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RVbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Lbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LovR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Wri = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FdrN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Mice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fsp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackParam SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3541,12 +3417,6 @@ SUBROUTINE IceD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInput' @@ -3772,8 +3642,10 @@ SUBROUTINE IceD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceD_PackOutput @@ -3790,12 +3662,6 @@ SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3863,15 +3729,10 @@ SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceD_UnPackOutput @@ -3950,8 +3811,8 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3966,6 +3827,8 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceD_Input_ExtrapInterp1 @@ -3997,8 +3860,9 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp2' @@ -4020,6 +3884,8 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceD_Input_ExtrapInterp2 @@ -4099,12 +3965,12 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4117,15 +3983,15 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE IceD_Output_ExtrapInterp1 @@ -4156,13 +4022,14 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4181,16 +4048,16 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE IceD_Output_ExtrapInterp2 diff --git a/modules/icedyn/src/Registry_IceDyn.txt b/modules/icedyn/src/Registry_IceDyn.txt index 789f55eec2..b230ebf9d9 100644 --- a/modules/icedyn/src/Registry_IceDyn.txt +++ b/modules/icedyn/src/Registry_IceDyn.txt @@ -166,7 +166,7 @@ typedef ^ ^ ^ SubModNo typedef ^ ^ ^ NumOuts - - - "The number of output channels" - typedef ^ ^ ^ method - - - "integration method: 1-RK4, 2-AB4, 3-ABM4" - typedef ^ ^ ^ TmStep - - - "Total time step" - -typedef ^ ^ CHARACTER(10) OutName {:} - - "Names of all requested output parameters" - +typedef ^ ^ CHARACTER(ChanLen) OutName {:} - - "Names of all requested output parameters" - typedef ^ ^ ^ OutUnit {:} - - "Units of all requested output parameters" - typedef ^ ^ CHARACTER(1024) RootName - - - "Rootname" - # ..... Ice Model 1 ............................................................................................................... diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index cc860d0a58..630cf872cc 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -210,20 +210,20 @@ SUBROUTINE IceFloe_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%simLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%simLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%gravity + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IceFloe_PackInitInput SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -239,12 +239,6 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -260,20 +254,20 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%simLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%simLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IceFloe_UnPackInitInput SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -438,12 +432,12 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -455,12 +449,12 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -505,12 +499,6 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -538,19 +526,12 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -565,19 +546,12 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -712,8 +686,8 @@ SUBROUTINE IceFloe_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackContState SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -729,12 +703,6 @@ SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackContState' @@ -748,8 +716,8 @@ SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackContState SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -843,8 +811,8 @@ SUBROUTINE IceFloe_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackDiscState SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -860,12 +828,6 @@ SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackDiscState' @@ -879,8 +841,8 @@ SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackDiscState SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -974,8 +936,8 @@ SUBROUTINE IceFloe_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackConstrState SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -991,12 +953,6 @@ SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackConstrState' @@ -1010,8 +966,8 @@ SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackConstrState SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1105,8 +1061,8 @@ SUBROUTINE IceFloe_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackOtherState SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1122,12 +1078,6 @@ SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackOtherState' @@ -1141,8 +1091,8 @@ SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackOtherState SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1236,8 +1186,8 @@ SUBROUTINE IceFloe_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackMisc SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1253,12 +1203,6 @@ SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackMisc' @@ -1272,8 +1216,8 @@ SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackMisc SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1492,29 +1436,33 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%loadSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%loadSeries))-1 ) = PACK(InData%loadSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%loadSeries) + DO i2 = LBOUND(InData%loadSeries,2), UBOUND(InData%loadSeries,2) + DO i1 = LBOUND(InData%loadSeries,1), UBOUND(InData%loadSeries,1) + ReKiBuf(Re_Xferred) = InData%loadSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%iceVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%iceDirection - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%minStrength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%minStrengthNegVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%defaultArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%crushArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%coeffStressRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C(4) - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rampTime - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%iceVel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%iceDirection + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%minStrength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%minStrengthNegVel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%defaultArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%crushArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%coeffStressRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C(4) + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rampTime + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%legX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1525,8 +1473,10 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%legX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%legX))-1 ) = PACK(InData%legX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%legX) + DO i1 = LBOUND(InData%legX,1), UBOUND(InData%legX,1) + ReKiBuf(Re_Xferred) = InData%legX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%legY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1538,8 +1488,10 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%legY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%legY))-1 ) = PACK(InData%legY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%legY) + DO i1 = LBOUND(InData%legY,1), UBOUND(InData%legY,1) + ReKiBuf(Re_Xferred) = InData%legY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ks) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1551,19 +1503,21 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ks,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ks)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ks))-1 ) = PACK(InData%ks,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ks) + DO i1 = LBOUND(InData%ks,1), UBOUND(InData%ks,1) + ReKiBuf(Re_Xferred) = InData%ks(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iceType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%logUnitNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%singleLoad , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%initFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numLegs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iceType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%logUnitNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%singleLoad, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%initFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackParam SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1579,12 +1533,6 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1616,36 +1564,33 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%loadSeries)>0) OutData%loadSeries = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%loadSeries))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%loadSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%loadSeries,2), UBOUND(OutData%loadSeries,2) + DO i1 = LBOUND(OutData%loadSeries,1), UBOUND(OutData%loadSeries,1) + OutData%loadSeries(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%iceVel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%iceDirection = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%minStrength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%minStrengthNegVel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%defaultArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%crushArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%coeffStressRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C(4) = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rampTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%iceVel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%iceDirection = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%minStrength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%minStrengthNegVel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%defaultArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%crushArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%coeffStressRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C(4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rampTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1659,15 +1604,10 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%legX)>0) OutData%legX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%legX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%legX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%legX,1), UBOUND(OutData%legX,1) + OutData%legX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legY not allocated Int_Xferred = Int_Xferred + 1 @@ -1682,15 +1622,10 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%legY)>0) OutData%legY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%legY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%legY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%legY,1), UBOUND(OutData%legY,1) + OutData%legY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ks not allocated Int_Xferred = Int_Xferred + 1 @@ -1705,26 +1640,21 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ks)>0) OutData%ks = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ks))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ks) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ks,1), UBOUND(OutData%ks,1) + OutData%ks(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%numLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%iceType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%logUnitNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%singleLoad = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%initFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%numLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iceType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%logUnitNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%singleLoad = TRANSFER(IntKiBuf(Int_Xferred), OutData%singleLoad) + Int_Xferred = Int_Xferred + 1 + OutData%initFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%initFlag) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackParam SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1881,12 +1811,6 @@ SUBROUTINE IceFloe_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInput' @@ -2112,8 +2036,10 @@ SUBROUTINE IceFloe_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceFloe_PackOutput @@ -2130,12 +2056,6 @@ SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2203,15 +2123,10 @@ SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceFloe_UnPackOutput @@ -2290,8 +2205,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2306,6 +2221,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceFloe_Input_ExtrapInterp1 @@ -2337,8 +2254,9 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp2' @@ -2360,6 +2278,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceFloe_Input_ExtrapInterp2 @@ -2439,12 +2359,12 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2457,15 +2377,15 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE IceFloe_Output_ExtrapInterp1 @@ -2496,13 +2416,14 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2521,16 +2442,16 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE IceFloe_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/IfW_4Dext_Types.f90 b/modules/inflowwind/src/IfW_4Dext_Types.f90 index f34008bcb5..b87a4e1fe4 100644 --- a/modules/inflowwind/src/IfW_4Dext_Types.f90 +++ b/modules/inflowwind/src/IfW_4Dext_Types.f90 @@ -159,12 +159,18 @@ SUBROUTINE IfW_4Dext_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n))-1 ) = PACK(InData%n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%delta))-1 ) = PACK(InData%delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pZero))-1 ) = PACK(InData%pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pZero) + DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) + IntKiBuf(Int_Xferred) = InData%n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) + ReKiBuf(Re_Xferred) = InData%delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) + ReKiBuf(Re_Xferred) = InData%pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_PackInitInput SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -180,12 +186,6 @@ SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -206,37 +206,22 @@ SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = 1 i1_l = LBOUND(OutData%n,1) i1_u = UBOUND(OutData%n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) + OutData%n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%delta,1) i1_u = UBOUND(OutData%delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) + OutData%delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%pZero,1) i1_u = UBOUND(OutData%pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%pZero) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) + OutData%pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_UnPackInitInput SUBROUTINE IfW_4Dext_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -393,12 +378,6 @@ SUBROUTINE IfW_4Dext_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_UnPackInitOutput' @@ -600,11 +579,21 @@ SUBROUTINE IfW_4Dext_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i5 = LBOUND(InData%V,5), UBOUND(InData%V,5) + DO i4 = LBOUND(InData%V,4), UBOUND(InData%V,4) + DO i3 = LBOUND(InData%V,3), UBOUND(InData%V,3) + DO i2 = LBOUND(InData%V,2), UBOUND(InData%V,2) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TgridStart - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TgridStart + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_4Dext_PackMisc SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -620,12 +609,6 @@ SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -669,18 +652,21 @@ SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask5, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%V,5), UBOUND(OutData%V,5) + DO i4 = LBOUND(OutData%V,4), UBOUND(OutData%V,4) + DO i3 = LBOUND(OutData%V,3), UBOUND(OutData%V,3) + DO i2 = LBOUND(OutData%V,2), UBOUND(OutData%V,2) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF - OutData%TgridStart = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TgridStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_4Dext_UnPackMisc SUBROUTINE IfW_4Dext_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -779,12 +765,18 @@ SUBROUTINE IfW_4Dext_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n))-1 ) = PACK(InData%n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%delta))-1 ) = PACK(InData%delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pZero))-1 ) = PACK(InData%pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pZero) + DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) + IntKiBuf(Int_Xferred) = InData%n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) + ReKiBuf(Re_Xferred) = InData%delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) + ReKiBuf(Re_Xferred) = InData%pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_PackParam SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -800,12 +792,6 @@ SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -822,37 +808,22 @@ SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%n,1) i1_u = UBOUND(OutData%n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) + OutData%n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%delta,1) i1_u = UBOUND(OutData%delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) + OutData%delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%pZero,1) i1_u = UBOUND(OutData%pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%pZero) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) + OutData%pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_UnPackParam END MODULE IfW_4Dext_Types diff --git a/modules/inflowwind/src/IfW_BladedFFWind.f90 b/modules/inflowwind/src/IfW_BladedFFWind.f90 index dac44e47c8..d5cf83db65 100644 --- a/modules/inflowwind/src/IfW_BladedFFWind.f90 +++ b/modules/inflowwind/src/IfW_BladedFFWind.f90 @@ -1604,17 +1604,21 @@ SUBROUTINE IfW_BladedFFWind_CalcOutput(Time, PositionXYZ, ParamData, Velocity, D ! Step through all the positions and get the velocities DO PointNum = 1, NumPoints - ! Calculate the velocity for the position - Velocity(:,PointNum) = FF_Interp(Time,PositionXYZ(:,PointNum),ParamData,MiscVars,TmpErrStat,TmpErrMsg) - - ! Error handling - IF (TmpErrStat /= ErrID_None) THEN ! adding this so we don't have to convert numbers to strings every time - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, "IfW_BladedFFWind:CalcOutput [position=("// & - TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & - TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & - TRIM(Num2LStr(PositionXYZ(3,PointNum)))//")]" ) - IF (ErrStat >= AbortErrLev) RETURN - END IF + ! If the position is (0,0,0), assume it was never set and skip calculating + if ( TwoNorm(PositionXYZ(1:3,PointNum)) > 0.0_ReKi ) then + + ! Calculate the velocity for the position + Velocity(:,PointNum) = FF_Interp(Time,PositionXYZ(:,PointNum),ParamData,MiscVars,TmpErrStat,TmpErrMsg) + + ! Error handling + IF (TmpErrStat /= ErrID_None) THEN ! adding this so we don't have to convert numbers to strings every time + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, "IfW_BladedFFWind:CalcOutput [position=("// & + TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & + TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & + TRIM(Num2LStr(PositionXYZ(3,PointNum)))//")]" ) + IF (ErrStat >= AbortErrLev) RETURN + END IF + endif ENDDO diff --git a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 index 74d536e638..fd15ba6f7d 100644 --- a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 @@ -178,14 +178,14 @@ SUBROUTINE IfW_BladedFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerFileExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerFileExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackInitInput SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -201,12 +201,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -224,14 +218,14 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TowerFileExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TowerFileExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerFileExist) + Int_Xferred = Int_Xferred + 1 + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackInitInput SUBROUTINE IfW_BladedFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -376,8 +370,10 @@ SUBROUTINE IfW_BladedFFWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_BladedFFWind_PackInitOutput SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -393,12 +389,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -455,15 +445,10 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%TI,1) i1_u = UBOUND(OutData%TI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_BladedFFWind_UnPackInitOutput SUBROUTINE IfW_BladedFFWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -557,8 +542,8 @@ SUBROUTINE IfW_BladedFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackMisc SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -574,12 +559,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_UnPackMisc' @@ -593,8 +572,8 @@ SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackMisc SUBROUTINE IfW_BladedFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -782,12 +761,12 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Periodic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerDataExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerDataExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FFData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -807,8 +786,16 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFData))-1 ) = PACK(InData%FFData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFData) + DO i4 = LBOUND(InData%FFData,4), UBOUND(InData%FFData,4) + DO i3 = LBOUND(InData%FFData,3), UBOUND(InData%FFData,3) + DO i2 = LBOUND(InData%FFData,2), UBOUND(InData%FFData,2) + DO i1 = LBOUND(InData%FFData,1), UBOUND(InData%FFData,1) + ReKiBuf(Re_Xferred) = InData%FFData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FFTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -826,45 +813,51 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFTower,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFTower))-1 ) = PACK(InData%FFTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFTower) + DO i3 = LBOUND(InData%FFTower,3), UBOUND(InData%FFTower,3) + DO i2 = LBOUND(InData%FFTower,2), UBOUND(InData%FFTower,2) + DO i1 = LBOUND(InData%FFTower,1), UBOUND(InData%FFTower,1) + ReKiBuf(Re_Xferred) = InData%FFTower(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFDTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFYHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFYD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFZD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvMFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MeanFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFDTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFYHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFZHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitXPosition + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFYD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFZD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvMFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MeanFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TotalTime + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFComp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NYGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NZGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindFileFormat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackParam SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -880,12 +873,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -903,12 +890,12 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Periodic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TowerDataExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) + Int_Xferred = Int_Xferred + 1 + OutData%TowerDataExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerDataExist) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -931,15 +918,16 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%FFData)>0) OutData%FFData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%FFData,4), UBOUND(OutData%FFData,4) + DO i3 = LBOUND(OutData%FFData,3), UBOUND(OutData%FFData,3) + DO i2 = LBOUND(OutData%FFData,2), UBOUND(OutData%FFData,2) + DO i1 = LBOUND(OutData%FFData,1), UBOUND(OutData%FFData,1) + OutData%FFData(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 ! FFTower not allocated Int_Xferred = Int_Xferred + 1 @@ -960,52 +948,51 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FFTower)>0) OutData%FFTower = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFTower))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFTower) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FFTower,3), UBOUND(OutData%FFTower,3) + DO i2 = LBOUND(OutData%FFTower,2), UBOUND(OutData%FFTower,2) + DO i1 = LBOUND(OutData%FFTower,1), UBOUND(OutData%FFTower,1) + OutData%FFTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%FFDTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFYHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFZHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFYD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFZD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvMFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MeanFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NFFComp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFFSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FFDTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFYHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFZHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitXPosition = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFYD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFZD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvMFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MeanFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TotalTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NFFComp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFFSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NYGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NZGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackParam END MODULE IfW_BladedFFWind_Types diff --git a/modules/inflowwind/src/IfW_HAWCWind.f90 b/modules/inflowwind/src/IfW_HAWCWind.f90 index 6861a1705c..7f4d24872d 100644 --- a/modules/inflowwind/src/IfW_HAWCWind.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind.f90 @@ -42,6 +42,7 @@ MODULE IfW_HAWCWind PUBLIC :: IfW_HAWCWind_CalcOutput INTEGER(IntKi), PARAMETER :: nc = 3 !< number of wind components + INTEGER(IntKi), PARAMETER :: WindProfileType_None = -1 !< don't add wind profile; already included in input data INTEGER(IntKi), PARAMETER :: WindProfileType_Constant = 0 !< constant wind INTEGER(IntKi), PARAMETER :: WindProfileType_Log = 1 !< logarithmic INTEGER(IntKi), PARAMETER :: WindProfileType_PL = 2 !< power law @@ -95,8 +96,9 @@ SUBROUTINE IfW_HAWCWind_Init(InitInp, p, MiscVars, Interval, InitOut, ErrStat, E p%nz = InitInp%nz p%RefHt = InitInp%RefHt p%URef = InitInp%URef - p%InitPosition = 0.0_ReKi ! bjj: someday we may want to let the users give an offset time/position - p%InitPosition(1) = InitInp%dx + p%InitPosition = InitInp%InitPosition + if (EqualRealNos(InitInp%InitPosition(1), 0.0_ReKi)) p%InitPosition(1) = InitInp%dx ! This is the old behaviour + p%deltaXInv = 1.0 / InitInp%dx p%deltaYInv = 1.0 / InitInp%dy @@ -145,7 +147,7 @@ SUBROUTINE IfW_HAWCWind_Init(InitInp, p, MiscVars, Interval, InitOut, ErrStat, E WRITE(InitInp%SumFileUnit,'(A)', IOSTAT=TmpErrStat) 'HAWC wind type. Read by InflowWind sub-module '//TRIM(GetNVD(IfW_HAWCWind_Ver)) WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Reference height (m): ',p%RefHt - WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Timestep (s): ',p%deltaXInv / p%URef + WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Timestep (s): ',1.0_ReKi / (p%deltaXInv * p%URef) WRITE(InitInp%SumFileUnit,'(A34,I12)', IOSTAT=TmpErrStat) ' Number of timesteps: ',p%nx WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Mean windspeed (m/s): ',p%URef WRITE(InitInp%SumFileUnit,'(A)', IOSTAT=TmpErrStat) ' Time range (s): [ '// & @@ -213,7 +215,7 @@ SUBROUTINE ValidateInput(InitInp, ErrStat, ErrMsg) if (InitInp%WindProfileType == WindProfileType_Log) then if ( InitInp%z0 < 0.0_ReKi .or. EqualRealNos( InitInp%z0, 0.0_ReKi ) ) & call SetErrStat( ErrID_Fatal, 'The surface roughness length, Z0, must be greater than zero', ErrStat, ErrMsg, RoutineName ) - elseif ( InitInp%WindProfileType < WindProfileType_Constant .or. InitInp%WindProfileType > WindProfileType_PL) then + elseif ( InitInp%WindProfileType < WindProfileType_None .or. InitInp%WindProfileType > WindProfileType_PL) then call SetErrStat( ErrID_Fatal, 'The WindProfile type must be 0 (constant), 1 (logarithmic) or 2 (power law).', ErrStat, ErrMsg, RoutineName ) end if @@ -532,18 +534,22 @@ SUBROUTINE IfW_HAWCWind_CalcOutput(Time, PositionXYZ, p, Velocity, DiskVel, Misc ! Step through all the positions and get the velocities DO PointNum = 1, NumPoints - ! Calculate the velocity for the position - Velocity(:,PointNum) = FF_Interp(Time,PositionXYZ(:,PointNum),p,MiscVars,TmpErrStat,TmpErrMsg) + ! If the position is (0,0,0), assume it was never set and skip calculating + if ( TwoNorm(PositionXYZ(1:3,PointNum)) > 0.0_ReKi ) then + ! Calculate the velocity for the position + Velocity(:,PointNum) = FF_Interp(Time,PositionXYZ(:,PointNum),p,MiscVars,TmpErrStat,TmpErrMsg) - ! Error handling - IF (TmpErrStat /= ErrID_None) THEN ! adding this so we don't have to convert numbers to strings every time - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName//" [position=("// & - TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & - TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & - TRIM(Num2LStr(PositionXYZ(3,PointNum)))//") in wind-file coordinates]" ) - IF (ErrStat >= AbortErrLev) RETURN - END IF + + ! Error handling + IF (TmpErrStat /= ErrID_None) THEN ! adding this so we don't have to convert numbers to strings every time + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName//" [position=("// & + TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & + TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & + TRIM(Num2LStr(PositionXYZ(3,PointNum)))//") in wind-file coordinates]" ) + IF (ErrStat >= AbortErrLev) RETURN + END IF + endif ENDDO diff --git a/modules/inflowwind/src/IfW_HAWCWind.txt b/modules/inflowwind/src/IfW_HAWCWind.txt index 278d9be3f2..4d38bd5672 100644 --- a/modules/inflowwind/src/IfW_HAWCWind.txt +++ b/modules/inflowwind/src/IfW_HAWCWind.txt @@ -31,6 +31,7 @@ typedef ^ ^ ReKi RefHt typedef ^ ^ ReKi URef - 0 - "Mean u-component wind speed at the reference height" meters typedef ^ ^ ReKi PLExp - 0 - "Power law exponent (used for PL wind profile type only)" - typedef ^ ^ ReKi Z0 - 0 - "Surface roughness length (used for LOG wind profile type only)" - +typedef ^ ^ ReKi InitPosition 3 0 - "the initial position of grid (distance in FF is offset)" meters # Init Output diff --git a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 index 18a96ae642..63058dc0d0 100644 --- a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 @@ -51,6 +51,7 @@ MODULE IfW_HAWCWind_Types REAL(ReKi) :: URef = 0 !< Mean u-component wind speed at the reference height [meters] REAL(ReKi) :: PLExp = 0 !< Power law exponent (used for PL wind profile type only) [-] REAL(ReKi) :: Z0 = 0 !< Surface roughness length (used for LOG wind profile type only) [-] + REAL(ReKi) , DIMENSION(1:3) :: InitPosition !< the initial position of grid (distance in FF is offset) [meters] END TYPE IfW_HAWCWind_InitInputType ! ======================= ! ========= IfW_HAWCWind_InitOutputType ======= @@ -141,6 +142,7 @@ SUBROUTINE IfW_HAWCWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlC DstInitInputData%URef = SrcInitInputData%URef DstInitInputData%PLExp = SrcInitInputData%PLExp DstInitInputData%Z0 = SrcInitInputData%Z0 + DstInitInputData%InitPosition = SrcInitInputData%InitPosition END SUBROUTINE IfW_HAWCWind_CopyInitInput SUBROUTINE IfW_HAWCWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -205,6 +207,7 @@ SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Re_BufSz = Re_BufSz + 1 ! URef Re_BufSz = Re_BufSz + 1 ! PLExp Re_BufSz = Re_BufSz + 1 ! Z0 + Re_BufSz = Re_BufSz + SIZE(InData%InitPosition) ! InitPosition IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -233,41 +236,49 @@ SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_Xferred = 1 DO i1 = LBOUND(InData%WindFileName,1), UBOUND(InData%WindFileName,1) - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nz - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ScaleMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SF))-1 ) = PACK(InData%SF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaF))-1 ) = PACK(InData%SigmaF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaF) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dz - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%URef - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Z0 - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ScaleMethod + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) + ReKiBuf(Re_Xferred) = InData%SF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SigmaF,1), UBOUND(InData%SigmaF,1) + ReKiBuf(Re_Xferred) = InData%SigmaF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%dx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindProfileType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%URef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Z0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%InitPosition,1), UBOUND(InData%InitPosition,1) + ReKiBuf(Re_Xferred) = InData%InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_PackInitInput SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -283,12 +294,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -308,67 +313,56 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Xferred = 1 i1_l = LBOUND(OutData%WindFileName,1) i1_u = UBOUND(OutData%WindFileName,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WindFileName,1), UBOUND(OutData%WindFileName,1) - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ScaleMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ScaleMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SF,1) i1_u = UBOUND(OutData%SF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) + OutData%SF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SigmaF,1) i1_u = UBOUND(OutData%SigmaF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SigmaF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaF) - DEALLOCATE(mask1) - OutData%dx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WindProfileType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%SigmaF,1), UBOUND(OutData%SigmaF,1) + OutData%SigmaF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%dx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindProfileType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%InitPosition,1) + i1_u = UBOUND(OutData%InitPosition,1) + DO i1 = LBOUND(OutData%InitPosition,1), UBOUND(OutData%InitPosition,1) + OutData%InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_UnPackInitInput SUBROUTINE IfW_HAWCWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -513,8 +507,10 @@ SUBROUTINE IfW_HAWCWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SF))-1 ) = PACK(InData%SF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SF) + DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) + ReKiBuf(Re_Xferred) = InData%SF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_PackInitOutput SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -530,12 +526,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -592,15 +582,10 @@ SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%SF,1) i1_u = UBOUND(OutData%SF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) + OutData%SF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_UnPackInitOutput SUBROUTINE IfW_HAWCWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -694,8 +679,8 @@ SUBROUTINE IfW_HAWCWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackContState SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -711,12 +696,6 @@ SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackContState' @@ -730,8 +709,8 @@ SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackContState SUBROUTINE IfW_HAWCWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -825,8 +804,8 @@ SUBROUTINE IfW_HAWCWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackDiscState SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -842,12 +821,6 @@ SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackDiscState' @@ -861,8 +834,8 @@ SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackDiscState SUBROUTINE IfW_HAWCWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -956,8 +929,8 @@ SUBROUTINE IfW_HAWCWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackConstrState SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -973,12 +946,6 @@ SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackConstrState' @@ -992,8 +959,8 @@ SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackConstrState SUBROUTINE IfW_HAWCWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1087,8 +1054,8 @@ SUBROUTINE IfW_HAWCWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackOtherState SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1104,12 +1071,6 @@ SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackOtherState' @@ -1123,8 +1084,8 @@ SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackOtherState SUBROUTINE IfW_HAWCWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1218,8 +1179,8 @@ SUBROUTINE IfW_HAWCWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackMisc SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1235,12 +1196,6 @@ SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackMisc' @@ -1254,8 +1209,8 @@ SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackMisc SUBROUTINE IfW_HAWCWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1401,14 +1356,14 @@ SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%HAWCData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1428,25 +1383,35 @@ SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HAWCData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HAWCData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HAWCData))-1 ) = PACK(InData%HAWCData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HAWCData) + DO i4 = LBOUND(InData%HAWCData,4), UBOUND(InData%HAWCData,4) + DO i3 = LBOUND(InData%HAWCData,3), UBOUND(InData%HAWCData,3) + DO i2 = LBOUND(InData%HAWCData,2), UBOUND(InData%HAWCData,2) + DO i1 = LBOUND(InData%HAWCData,1), UBOUND(InData%HAWCData,1) + ReKiBuf(Re_Xferred) = InData%HAWCData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitPosition))-1 ) = PACK(InData%InitPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InitPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LengthX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LengthYHalf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaXInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaYInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaZInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%URef - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%InitPosition,1), UBOUND(InData%InitPosition,1) + ReKiBuf(Re_Xferred) = InData%InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LengthX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LengthYHalf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaXInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaYInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaZInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%URef + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackParam SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1462,12 +1427,6 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1485,14 +1444,14 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HAWCData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1515,41 +1474,37 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HAWCData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%HAWCData)>0) OutData%HAWCData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HAWCData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HAWCData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%HAWCData,4), UBOUND(OutData%HAWCData,4) + DO i3 = LBOUND(OutData%HAWCData,3), UBOUND(OutData%HAWCData,3) + DO i2 = LBOUND(OutData%HAWCData,2), UBOUND(OutData%HAWCData,2) + DO i1 = LBOUND(OutData%HAWCData,1), UBOUND(OutData%HAWCData,1) + OutData%HAWCData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%InitPosition,1) i1_u = UBOUND(OutData%InitPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InitPosition) - DEALLOCATE(mask1) - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LengthX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LengthYHalf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaXInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaYInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaZInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%InitPosition,1), UBOUND(OutData%InitPosition,1) + OutData%InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LengthX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LengthYHalf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaXInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaYInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaZInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackParam SUBROUTINE IfW_HAWCWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1678,8 +1633,12 @@ SUBROUTINE IfW_HAWCWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Position,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Position)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) + DO i2 = LBOUND(InData%Position,2), UBOUND(InData%Position,2) + DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) + ReKiBuf(Re_Xferred) = InData%Position(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE IfW_HAWCWind_PackInput @@ -1696,12 +1655,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1733,15 +1686,12 @@ SUBROUTINE IfW_HAWCWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Position.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Position)>0) OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Position,2), UBOUND(OutData%Position,2) + DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) + OutData%Position(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE IfW_HAWCWind_UnPackInput diff --git a/modules/inflowwind/src/IfW_TSFFWind.f90 b/modules/inflowwind/src/IfW_TSFFWind.f90 index 56872d883c..aaf554d6fc 100644 --- a/modules/inflowwind/src/IfW_TSFFWind.f90 +++ b/modules/inflowwind/src/IfW_TSFFWind.f90 @@ -640,23 +640,36 @@ SUBROUTINE IfW_TSFFWind_CalcOutput(Time, PositionXYZ, ParamData, Velocity, Disk ! Step through all the positions and get the velocities + + !$OMP PARALLEL default(shared) if(PointNum>1000) + !$OMP do private(PointNum, TmpErrStat, TmpErrMsg ) schedule(runtime) DO PointNum = 1, NumPoints - ! Calculate the velocity for the position - Velocity(:,PointNum) = FF_Interp(Time,PositionXYZ(:,PointNum),ParamData,MiscVars,TmpErrStat,TmpErrMsg) + ! If the position is (0,0,0), assume it was never set and skip calculating + if ( TwoNorm(PositionXYZ(1:3,PointNum)) > 0.0_ReKi ) then + + ! Calculate the velocity for the position + Velocity(:,PointNum) = FF_Interp(Time,PositionXYZ(:,PointNum),ParamData,MiscVars,TmpErrStat,TmpErrMsg) - ! Error handling - IF (TmpErrStat /= ErrID_None) THEN ! adding this so we don't have to convert numbers to strings every time - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName//" [position=("// & - TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & - TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & - TRIM(Num2LStr(PositionXYZ(3,PointNum)))//") in wind-file coordinates]" ) - IF (ErrStat >= AbortErrLev) RETURN - END IF + ! Error handling + IF (TmpErrStat /= ErrID_None) THEN ! adding this so we don't have to convert numbers to strings every time + !$OMP CRITICAL ! Needed to avoid data race on ErrStat and ErrMsg + ErrStat = ErrID_None + ErrMsg = "" + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName//" [position=("// & + TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & + TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & + TRIM(Num2LStr(PositionXYZ(3,PointNum)))//") in wind-file coordinates]" ) + !$OMP END CRITICAL + END IF + endif ENDDO + !$OMP END DO + !$OMP END PARALLEL + IF (ErrStat >= AbortErrLev) RETURN ! Return cannot be in parallel loop !REMOVE THIS for AeroDyn 15 diff --git a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 index 5184d52280..687f7eb742 100644 --- a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 @@ -174,12 +174,12 @@ SUBROUTINE IfW_TSFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackInitInput SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -195,12 +195,6 @@ SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -218,12 +212,12 @@ SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackInitInput SUBROUTINE IfW_TSFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -380,12 +374,6 @@ SUBROUTINE IfW_TSFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_UnPackInitOutput' @@ -532,8 +520,8 @@ SUBROUTINE IfW_TSFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackMisc SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -549,12 +537,6 @@ SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_UnPackMisc' @@ -568,8 +550,8 @@ SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackMisc SUBROUTINE IfW_TSFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -757,12 +739,12 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerDataExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Periodic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerDataExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FFData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -782,8 +764,16 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFData))-1 ) = PACK(InData%FFData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFData) + DO i4 = LBOUND(InData%FFData,4), UBOUND(InData%FFData,4) + DO i3 = LBOUND(InData%FFData,3), UBOUND(InData%FFData,3) + DO i2 = LBOUND(InData%FFData,2), UBOUND(InData%FFData,2) + DO i1 = LBOUND(InData%FFData,1), UBOUND(InData%FFData,1) + ReKiBuf(Re_Xferred) = InData%FFData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FFTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -801,45 +791,51 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFTower,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFTower))-1 ) = PACK(InData%FFTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFTower) + DO i3 = LBOUND(InData%FFTower,3), UBOUND(InData%FFTower,3) + DO i2 = LBOUND(InData%FFTower,2), UBOUND(InData%FFTower,2) + DO i1 = LBOUND(InData%FFTower,1), UBOUND(InData%FFTower,1) + ReKiBuf(Re_Xferred) = InData%FFTower(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFDTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFYHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFYD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFZD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvMFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MeanFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFDTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFYHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFZHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitXPosition + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFYD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFZD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvMFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MeanFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TotalTime + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFComp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NYGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NZGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindFileFormat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackParam SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -855,12 +851,6 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -878,12 +868,12 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TowerDataExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Periodic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TowerDataExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerDataExist) + Int_Xferred = Int_Xferred + 1 + OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -906,15 +896,16 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%FFData)>0) OutData%FFData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%FFData,4), UBOUND(OutData%FFData,4) + DO i3 = LBOUND(OutData%FFData,3), UBOUND(OutData%FFData,3) + DO i2 = LBOUND(OutData%FFData,2), UBOUND(OutData%FFData,2) + DO i1 = LBOUND(OutData%FFData,1), UBOUND(OutData%FFData,1) + OutData%FFData(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 ! FFTower not allocated Int_Xferred = Int_Xferred + 1 @@ -935,52 +926,51 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FFTower)>0) OutData%FFTower = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFTower))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFTower) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FFTower,3), UBOUND(OutData%FFTower,3) + DO i2 = LBOUND(OutData%FFTower,2), UBOUND(OutData%FFTower,2) + DO i1 = LBOUND(OutData%FFTower,1), UBOUND(OutData%FFTower,1) + OutData%FFTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%FFDTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFYHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFZHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFYD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFZD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvMFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MeanFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NFFComp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFFSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FFDTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFYHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFZHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitXPosition = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFYD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFZD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvMFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MeanFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TotalTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NFFComp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFFSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NYGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NZGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackParam END MODULE IfW_TSFFWind_Types diff --git a/modules/inflowwind/src/IfW_UniformWind.f90 b/modules/inflowwind/src/IfW_UniformWind.f90 index c40b00a27a..8d4b7882ff 100644 --- a/modules/inflowwind/src/IfW_UniformWind.f90 +++ b/modules/inflowwind/src/IfW_UniformWind.f90 @@ -535,24 +535,32 @@ SUBROUTINE IfW_UniformWind_CalcOutput(Time, PositionXYZ, p, Velocity, DiskVel, m CALL InterpParams(Time, p, m, op) ! Step through all the positions and get the velocities + !$OMP PARALLEL default(shared) if(NumPoints>1000) + !$OMP do private(PointNum, TmpErrStat, TmpErrMsg ) schedule(runtime) DO PointNum = 1, NumPoints ! Calculate the velocity for the position call GetWindSpeed(PositionXYZ(:,PointNum), p, m, op, Velocity(:,PointNum), TmpErrStat, TmpErrMsg) ! Error handling - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - TmpErrMsg= " Error calculating the wind speed at position ("// & + !CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) + IF (TmpErrStat >= AbortErrLev) THEN + TmpErrMsg= trim(TmpErrMsg)//" Error calculating the wind speed at position ("// & TRIM(Num2LStr(PositionXYZ(1,PointNum)))//", "// & TRIM(Num2LStr(PositionXYZ(2,PointNum)))//", "// & TRIM(Num2LStr(PositionXYZ(3,PointNum)))//") in the wind-file coordinates" + !$OMP CRITICAL ! Needed to avoid data race on ErrStat and ErrMsg + ErrStat = ErrID_None + ErrMsg = "" CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - RETURN + !$OMP END CRITICAL ENDIF ENDDO + !$OMP END DO + !$OMP END PARALLEL + IF (ErrStat >= AbortErrLev) RETURN ! Return cannot be in parallel loop ! DiskVel term -- this represents the average across the disk -- sort of. This changes for AeroDyn 15 DiskVel = WindInf_ADhack_diskVel(Time, p, m, TmpErrStat, TmpErrMsg) @@ -677,6 +685,7 @@ SUBROUTINE GetWindSpeed(InputPosition, p, m, op, WindSpeed, ErrStat, ErrMsg) if ( InputPosition(3) < 0.0_ReKi ) then call SetErrStat(ErrID_Fatal,'Height must not be negative.',ErrStat,ErrMsg,'GetWindSpeed') + return end if !> Let \f{eqnarray}{ V_h & = & V \, \left( \frac{Z}{Z_{ref}} \right) ^ {V_{shr}} & \mbox{power-law wind shear} \\ diff --git a/modules/inflowwind/src/IfW_UniformWind_Types.f90 b/modules/inflowwind/src/IfW_UniformWind_Types.f90 index 740539a6f2..882554e796 100644 --- a/modules/inflowwind/src/IfW_UniformWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UniformWind_Types.f90 @@ -180,16 +180,16 @@ SUBROUTINE IfW_UniformWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ReferenceHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%ReferenceHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackInitInput SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -205,12 +205,6 @@ SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -225,16 +219,16 @@ SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%ReferenceHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%ReferenceHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackInitInput SUBROUTINE IfW_UniformWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -385,14 +379,16 @@ SUBROUTINE IfW_UniformWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WindFileDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindFileTRange))-1 ) = PACK(InData%WindFileTRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindFileTRange) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileNumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WindFileConstantDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WindFileDT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%WindFileTRange,1), UBOUND(InData%WindFileTRange,1) + ReKiBuf(Re_Xferred) = InData%WindFileTRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WindFileNumTSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WindFileConstantDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackInitOutput SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -408,12 +404,6 @@ SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -468,23 +458,18 @@ SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WindFileDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WindFileDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%WindFileTRange,1) i1_u = UBOUND(OutData%WindFileTRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WindFileTRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindFileTRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindFileTRange) - DEALLOCATE(mask1) - OutData%WindFileNumTSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileConstantDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%WindFileTRange,1), UBOUND(OutData%WindFileTRange,1) + OutData%WindFileTRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%WindFileNumTSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WindFileConstantDT) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackInitOutput SUBROUTINE IfW_UniformWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -578,8 +563,8 @@ SUBROUTINE IfW_UniformWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackMisc SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -595,12 +580,6 @@ SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_UnPackMisc' @@ -614,8 +593,8 @@ SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackMisc SUBROUTINE IfW_UniformWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -884,8 +863,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TData,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TData))-1 ) = PACK(InData%TData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TData) + DO i1 = LBOUND(InData%TData,1), UBOUND(InData%TData,1) + ReKiBuf(Re_Xferred) = InData%TData(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DELTA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -897,8 +878,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DELTA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DELTA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DELTA))-1 ) = PACK(InData%DELTA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DELTA) + DO i1 = LBOUND(InData%DELTA,1), UBOUND(InData%DELTA,1) + ReKiBuf(Re_Xferred) = InData%DELTA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -910,8 +893,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -923,8 +908,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VZ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VZ))-1 ) = PACK(InData%VZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VZ) + DO i1 = LBOUND(InData%VZ,1), UBOUND(InData%VZ,1) + ReKiBuf(Re_Xferred) = InData%VZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -936,8 +923,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HSHR))-1 ) = PACK(InData%HSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HSHR) + DO i1 = LBOUND(InData%HSHR,1), UBOUND(InData%HSHR,1) + ReKiBuf(Re_Xferred) = InData%HSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -949,8 +938,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VSHR))-1 ) = PACK(InData%VSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VSHR) + DO i1 = LBOUND(InData%VSHR,1), UBOUND(InData%VSHR,1) + ReKiBuf(Re_Xferred) = InData%VSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VLINSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -962,8 +953,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VLINSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VLINSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VLINSHR))-1 ) = PACK(InData%VLINSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VLINSHR) + DO i1 = LBOUND(InData%VLINSHR,1), UBOUND(InData%VLINSHR,1) + ReKiBuf(Re_Xferred) = InData%VLINSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VGUST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -975,15 +968,17 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VGUST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VGUST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VGUST))-1 ) = PACK(InData%VGUST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VGUST) + DO i1 = LBOUND(InData%VGUST,1), UBOUND(InData%VGUST,1) + ReKiBuf(Re_Xferred) = InData%VGUST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumDataLines - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumDataLines + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackParam SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -999,12 +994,6 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1032,15 +1021,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TData)>0) OutData%TData = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TData))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TData) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TData,1), UBOUND(OutData%TData,1) + OutData%TData(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DELTA not allocated Int_Xferred = Int_Xferred + 1 @@ -1055,15 +1039,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DELTA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DELTA)>0) OutData%DELTA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DELTA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DELTA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DELTA,1), UBOUND(OutData%DELTA,1) + OutData%DELTA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -1078,15 +1057,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VZ not allocated Int_Xferred = Int_Xferred + 1 @@ -1101,15 +1075,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VZ)>0) OutData%VZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VZ,1), UBOUND(OutData%VZ,1) + OutData%VZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1124,15 +1093,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HSHR)>0) OutData%HSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HSHR,1), UBOUND(OutData%HSHR,1) + OutData%HSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1147,15 +1111,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VSHR)>0) OutData%VSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VSHR,1), UBOUND(OutData%VSHR,1) + OutData%VSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VLINSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1170,15 +1129,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VLINSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VLINSHR)>0) OutData%VLINSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VLINSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VLINSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VLINSHR,1), UBOUND(OutData%VLINSHR,1) + OutData%VLINSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VGUST not allocated Int_Xferred = Int_Xferred + 1 @@ -1193,22 +1147,17 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VGUST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VGUST)>0) OutData%VGUST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VGUST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VGUST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VGUST,1), UBOUND(OutData%VGUST,1) + OutData%VGUST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumDataLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumDataLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackParam SUBROUTINE IfW_UniformWind_CopyIntrp( SrcIntrpData, DstIntrpData, CtrlCode, ErrStat, ErrMsg ) @@ -1314,20 +1263,20 @@ SUBROUTINE IfW_UniformWind_PackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DELTA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VLINSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VGUST - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DELTA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VLINSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VGUST + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackIntrp SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1343,12 +1292,6 @@ SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_UnPackIntrp' @@ -1362,20 +1305,20 @@ SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DELTA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VLINSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VGUST = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DELTA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VLINSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VGUST = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackIntrp END MODULE IfW_UniformWind_Types diff --git a/modules/inflowwind/src/IfW_UserWind_Types.f90 b/modules/inflowwind/src/IfW_UserWind_Types.f90 index a46c2f44c1..1fa5c484ac 100644 --- a/modules/inflowwind/src/IfW_UserWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UserWind_Types.f90 @@ -145,10 +145,10 @@ SUBROUTINE IfW_UserWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IfW_UserWind_PackInitInput SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -164,12 +164,6 @@ SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackInitInput' @@ -183,10 +177,10 @@ SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IfW_UserWind_UnPackInitInput SUBROUTINE IfW_UserWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -343,12 +337,6 @@ SUBROUTINE IfW_UserWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackInitOutput' @@ -495,8 +483,8 @@ SUBROUTINE IfW_UserWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_PackMisc SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -512,12 +500,6 @@ SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackMisc' @@ -531,8 +513,8 @@ SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_UnPackMisc SUBROUTINE IfW_UserWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -626,8 +608,8 @@ SUBROUTINE IfW_UserWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_PackParam SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -643,12 +625,6 @@ SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackParam' @@ -662,8 +638,8 @@ SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_UnPackParam END MODULE IfW_UserWind_Types diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index fe870be70d..6c12d390f9 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -557,6 +557,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, HAWC_InitData%URef = InputFileData%HAWC_URef HAWC_InitData%PLExp = InputFileData%HAWC_PLExp HAWC_InitData%Z0 = InputFileData%HAWC_Z0 + HAWC_InitData%InitPosition = InputFileData%HAWC_InitPosition ! Initialize the HAWCWind module diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index 0923fbce24..d634f2db00 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -99,9 +99,10 @@ typedef ^ ^ ReKi HAWC_URef typedef ^ ^ IntKi HAWC_ProfileType - - - "HAWC -- Wind profile type (0=constant;1=logarithmic;2=power law)" - typedef ^ ^ ReKi HAWC_PLExp - - - "HAWC -- Power law exponent (used for PL wind profile type only)" - typedef ^ ^ ReKi HAWC_Z0 - - - "HAWC -- Surface roughness length (used for LOG wind profile type only)" - +typedef ^ ^ ReKi HAWC_InitPosition 3 - - "HAWC -- initial position (offset for wind file box)" meters typedef ^ ^ LOGICAL SumPrint - - - "Write summary info to a file .IfW.Sum" - typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ^ CHARACTER(10) OutList : - - "List of user-requested output channels" - +typedef ^ ^ CHARACTER(ChanLen) OutList : - - "List of user-requested output channels" - typedef ^ ^ IntKi SensorType - SensorType_None - "Sensor type (for lidar/sensor module)" - typedef ^ ^ IntKi NumPulseGate - - - "the number of range gates to return wind speeds at" - typedef ^ ^ ReKi RotorApexOffsetPos 3 - - "position of the lidar unit relative to the rotor apex of rotation" m diff --git a/modules/inflowwind/src/InflowWind_Driver.f90 b/modules/inflowwind/src/InflowWind_Driver.f90 index edc7074f0d..d059d9bd12 100644 --- a/modules/inflowwind/src/InflowWind_Driver.f90 +++ b/modules/inflowwind/src/InflowWind_Driver.f90 @@ -888,9 +888,9 @@ PROGRAM InflowWind_Driver SUBROUTINE DriverCleanup() - CLOSE( Settings%WindGridOutputUnit ) - CLOSE( Settings%PointsOutputUnit ) - CLOSE( Settings%FFTOutputUnit ) + if (Settings%WindGridOutputUnit > -1_IntKi ) CLOSE( Settings%WindGridOutputUnit ) + if (Settings%PointsOutputUnit > -1_IntKi ) CLOSE( Settings%PointsOutputUnit ) + if (Settings%FFTOutputUnit > -1_IntKi ) CLOSE( Settings%FFTOutputUnit ) ! Find out how long this actually took diff --git a/modules/inflowwind/src/InflowWind_Subs.f90 b/modules/inflowwind/src/InflowWind_Subs.f90 index bd39768c73..8a6f457e7a 100644 --- a/modules/inflowwind/src/InflowWind_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Subs.f90 @@ -789,14 +789,24 @@ SUBROUTINE InflowWind_ReadInput( InputFileName, EchoFileName, InputFileData, Err RETURN END IF - - !---------------------- OUTPUT -------------------------------------------------- - CALL ReadCom( UnitInput, InputFileName, 'Section Header: Output', TmpErrStat, TmpErrMsg, UnitEcho ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Read HAWC_InitPosition (Shift of wind box) NOTE: This an optional input!!!! + InputFileData%HAWC_InitPosition(2:3) = 0.0_ReKi ! We are only using X, so only read in one. The data can handle 3 coords + CALL ReadVar( UnitInput, InputFileName, InputFileData%HAWC_InitPosition(1), 'HAWC_Position', & + 'Initial position of the HAWC wind file (shift along X usually)', TmpErrStat, TmpErrMsg, UnitEcho ) + if (TmpErrStat == ErrID_None) then + !---------------------- OUTPUT -------------------------------------------------- + CALL ReadCom( UnitInput, InputFileName, 'Section Header: Output', TmpErrStat, TmpErrMsg, UnitEcho ) + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + else + InputFileData%HAWC_InitPosition = 0.0_ReKi + TmpErrStat = ErrID_None ! reset + TmpErrMsg = "" + ! NOTE: since we read in a line that wasn't a number, what we actually read was the header. + endif ! SumPrint - Print summary data to .IfW.sum (flag): CALL ReadVar( UnitInput, InputFileName, InputFileData%SumPrint, "SumPrint", "Print summary data to .IfW.sum (flag)", TmpErrStat, TmpErrMsg, UnitEcho) @@ -1740,7 +1750,7 @@ SUBROUTINE InflowWind_CloseSumFile( SumFileUnit, ErrStat, ErrMsg ) ! Local variables INTEGER(IntKi) :: TmpErrStat - CHARACTER(1024) :: TmpErrMsg + CHARACTER(ErrMsgLen) :: TmpErrMsg ! Initialize ErrStat diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 1596d07cd9..d8f2890b35 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -115,9 +115,10 @@ MODULE InflowWind_Types INTEGER(IntKi) :: HAWC_ProfileType !< HAWC -- Wind profile type (0=constant;1=logarithmic;2=power law) [-] REAL(ReKi) :: HAWC_PLExp !< HAWC -- Power law exponent (used for PL wind profile type only) [-] REAL(ReKi) :: HAWC_Z0 !< HAWC -- Surface roughness length (used for LOG wind profile type only) [-] + REAL(ReKi) , DIMENSION(1:3) :: HAWC_InitPosition !< HAWC -- initial position (offset for wind file box) [meters] LOGICAL :: SumPrint !< Write summary info to a file .IfW.Sum [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] INTEGER(IntKi) :: SensorType = SensorType_None !< Sensor type (for lidar/sensor module) [-] INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at [-] REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] @@ -350,44 +351,52 @@ SUBROUTINE InflowWind_PackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RefHt_Set , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ConstantDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TRange))-1 ) = PACK(InData%TRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%YRange))-1 ) = PACK(InData%YRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%YRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%YRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ZRange))-1 ) = PACK(InData%ZRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ZRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ZRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BinaryFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IsBinary , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TI_listed , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MWS - 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 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RefHt_Set, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstantDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TRange,1), UBOUND(InData%TRange,1) + ReKiBuf(Re_Xferred) = InData%TRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%TRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%YRange,1), UBOUND(InData%YRange,1) + ReKiBuf(Re_Xferred) = InData%YRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%YRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ZRange,1), UBOUND(InData%ZRange,1) + ReKiBuf(Re_Xferred) = InData%ZRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%ZRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BinaryFormat + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsBinary, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%TI_listed, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MWS + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackWindFileMetaData SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -403,12 +412,6 @@ SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -424,80 +427,60 @@ SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt_Set = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumTSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ConstantDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt_Set = TRANSFER(IntKiBuf(Int_Xferred), OutData%RefHt_Set) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumTSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstantDT) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TRange,1) i1_u = UBOUND(OutData%TRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TRange) - DEALLOCATE(mask1) - OutData%TRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TRange,1), UBOUND(OutData%TRange,1) + OutData%TRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%TRange_Limited) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%YRange,1) i1_u = UBOUND(OutData%YRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%YRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%YRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%YRange) - DEALLOCATE(mask1) - OutData%YRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%YRange,1), UBOUND(OutData%YRange,1) + OutData%YRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%YRange_Limited) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ZRange,1) i1_u = UBOUND(OutData%ZRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ZRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ZRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ZRange) - DEALLOCATE(mask1) - OutData%ZRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%BinaryFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IsBinary = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ZRange,1), UBOUND(OutData%ZRange,1) + OutData%ZRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%ZRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZRange_Limited) + Int_Xferred = Int_Xferred + 1 + OutData%BinaryFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IsBinary = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsBinary) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TI,1) i1_u = UBOUND(OutData%TI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask1) - OutData%TI_listed = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TI_listed = TRANSFER(IntKiBuf(Int_Xferred), OutData%TI_listed) + Int_Xferred = Int_Xferred + 1 + OutData%MWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackWindFileMetaData SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -590,6 +573,7 @@ SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCod DstInputFileData%HAWC_ProfileType = SrcInputFileData%HAWC_ProfileType DstInputFileData%HAWC_PLExp = SrcInputFileData%HAWC_PLExp DstInputFileData%HAWC_Z0 = SrcInputFileData%HAWC_Z0 + DstInputFileData%HAWC_InitPosition = SrcInputFileData%HAWC_InitPosition DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts IF (ALLOCATED(SrcInputFileData%OutList)) THEN @@ -722,6 +706,7 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 1 ! HAWC_ProfileType Re_BufSz = Re_BufSz + 1 ! HAWC_PLExp Re_BufSz = Re_BufSz + 1 ! HAWC_Z0 + Re_BufSz = Re_BufSz + SIZE(InData%HAWC_InitPosition) ! HAWC_InitPosition Int_BufSz = Int_BufSz + 1 ! SumPrint Int_BufSz = Int_BufSz + 1 ! NumOuts Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no @@ -760,14 +745,14 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EchoFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropagationDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWindVel + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WindVxiList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -778,8 +763,10 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVxiList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVxiList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVxiList))-1 ) = PACK(InData%WindVxiList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVxiList) + DO i1 = LBOUND(InData%WindVxiList,1), UBOUND(InData%WindVxiList,1) + ReKiBuf(Re_Xferred) = InData%WindVxiList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindVyiList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -791,8 +778,10 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVyiList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVyiList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVyiList))-1 ) = PACK(InData%WindVyiList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVyiList) + DO i1 = LBOUND(InData%WindVyiList,1), UBOUND(InData%WindVyiList,1) + ReKiBuf(Re_Xferred) = InData%WindVyiList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindVziList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -804,99 +793,105 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVziList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVziList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVziList))-1 ) = PACK(InData%WindVziList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVziList) + DO i1 = LBOUND(InData%WindVziList,1), UBOUND(InData%WindVziList,1) + ReKiBuf(Re_Xferred) = InData%WindVziList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_PLexp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%Uniform_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uniform_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uniform_RefLength - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%TSFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%BladedFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BladedFF_TowerFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CTTS_CoherentTurb , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CTTS_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%CTTS_Path) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_v) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_w) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ScaleMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_TStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_TEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_URef - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_Z0 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_HWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_PLexp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%Uniform_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%Uniform_RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Uniform_RefLength + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%TSFF_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%BladedFF_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%BladedFF_TowerFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_CoherentTurb, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%CTTS_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%CTTS_Path) + IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_v) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_w) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%HAWC_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_nz + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_RefHt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ScaleMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_TStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_TEnd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_URef + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ProfileType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_Z0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%HAWC_InitPosition,1), UBOUND(InData%HAWC_InitPosition,1) + ReKiBuf(Re_Xferred) = InData%HAWC_InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -907,21 +902,23 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE InflowWind_PackInputFile SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -937,12 +934,6 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -957,14 +948,14 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%EchoFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropagationDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NWindVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) + Int_Xferred = Int_Xferred + 1 + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropagationDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NWindVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVxiList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -978,15 +969,10 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVxiList)>0) OutData%WindVxiList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVxiList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVxiList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVxiList,1), UBOUND(OutData%WindVxiList,1) + OutData%WindVxiList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVyiList not allocated Int_Xferred = Int_Xferred + 1 @@ -1001,15 +987,10 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVyiList)>0) OutData%WindVyiList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVyiList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVyiList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVyiList,1), UBOUND(OutData%WindVyiList,1) + OutData%WindVyiList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVziList not allocated Int_Xferred = Int_Xferred + 1 @@ -1024,106 +1005,107 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVziList)>0) OutData%WindVziList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVziList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVziList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVziList,1), UBOUND(OutData%WindVziList,1) + OutData%WindVziList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Steady_HWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_PLexp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%Uniform_FileName) - OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Uniform_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Uniform_RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%TSFF_FileName) - OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%BladedFF_FileName) - OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BladedFF_TowerFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CTTS_CoherentTurb = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CTTS_FileName) - OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%CTTS_Path) - OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_u) - OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_v) - OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_w) - OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HAWC_nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_dx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_ScaleMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_SFx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SFy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SFz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_TStart = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_TEnd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_ProfileType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_PLExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_Z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Steady_HWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Steady_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Steady_PLexp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%Uniform_FileName) + OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Uniform_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Uniform_RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%TSFF_FileName) + OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%BladedFF_FileName) + OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BladedFF_TowerFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%BladedFF_TowerFile) + Int_Xferred = Int_Xferred + 1 + OutData%CTTS_CoherentTurb = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_CoherentTurb) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%CTTS_FileName) + OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%CTTS_Path) + OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_u) + OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_v) + OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_w) + OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%HAWC_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_dx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_dy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_dz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_ScaleMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_SFx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SFy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SFz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_TStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_TEnd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_ProfileType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_Z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%HAWC_InitPosition,1) + i1_u = UBOUND(OutData%HAWC_InitPosition,1) + DO i1 = LBOUND(OutData%HAWC_InitPosition,1), UBOUND(OutData%HAWC_InitPosition,1) + OutData%HAWC_InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1137,37 +1119,25 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE InflowWind_UnPackInputFile SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1335,22 +1305,22 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Use4Dext , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseInputFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use4Dext, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWindPoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL InflowWind_Packinputfile( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1450,12 +1420,6 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInitInput' @@ -1469,22 +1433,22 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFileName) - OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Use4Dext = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumWindPoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFileName) + OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%Use4Dext = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use4Dext) + Int_Xferred = Int_Xferred + 1 + OutData%NumWindPoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1890,12 +1854,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1907,12 +1871,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1980,12 +1944,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1997,12 +1961,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2014,8 +1978,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2027,8 +1993,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -2040,8 +2008,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE InflowWind_PackInitOutput @@ -2058,12 +2028,6 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2091,19 +2055,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2118,19 +2075,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2225,19 +2175,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2252,19 +2195,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -2279,15 +2215,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2302,15 +2233,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -2325,15 +2251,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE InflowWind_UnPackInitOutput @@ -2599,8 +2520,8 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 CALL IfW_UniformWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UniformWind, ErrStat2, ErrMsg2, OnlySize ) ! UniformWind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2779,8 +2700,10 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindViUVW) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2795,8 +2718,12 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViUVW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViUVW))-1 ) = PACK(InData%WindViUVW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViUVW) + DO i2 = LBOUND(InData%WindViUVW,2), UBOUND(InData%WindViUVW,2) + DO i1 = LBOUND(InData%WindViUVW,1), UBOUND(InData%WindViUVW,1) + ReKiBuf(Re_Xferred) = InData%WindViUVW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE InflowWind_PackMisc @@ -2813,12 +2740,6 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2834,8 +2755,8 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3089,15 +3010,10 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViUVW not allocated Int_Xferred = Int_Xferred + 1 @@ -3115,15 +3031,12 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViUVW)>0) OutData%WindViUVW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViUVW))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViUVW) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViUVW,2), UBOUND(OutData%WindViUVW,2) + DO i1 = LBOUND(OutData%WindViUVW,1), UBOUND(OutData%WindViUVW,1) + OutData%WindViUVW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE InflowWind_UnPackMisc @@ -3497,20 +3410,28 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%RootFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CTTS_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotToWind))-1 ) = PACK(InData%RotToWind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotToWind) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotFromWind))-1 ) = PACK(InData%RotFromWind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotFromWind) + DO I = 1, LEN(InData%RootFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropagationDir + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%RotToWind,2), UBOUND(InData%RotToWind,2) + DO i1 = LBOUND(InData%RotToWind,1), UBOUND(InData%RotToWind,1) + ReKiBuf(Re_Xferred) = InData%RotToWind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%RotFromWind,2), UBOUND(InData%RotFromWind,2) + DO i1 = LBOUND(InData%RotFromWind,1), UBOUND(InData%RotFromWind,1) + ReKiBuf(Re_Xferred) = InData%RotFromWind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%WindViXYZprime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3524,15 +3445,19 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViXYZprime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViXYZprime))-1 ) = PACK(InData%WindViXYZprime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViXYZprime) + DO i2 = LBOUND(InData%WindViXYZprime,2), UBOUND(InData%WindViXYZprime,2) + DO i1 = LBOUND(InData%WindViXYZprime,1), UBOUND(InData%WindViXYZprime,1) + ReKiBuf(Re_Xferred) = InData%WindViXYZprime(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ReferenceHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ReferenceHeight + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWindVel + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WindViXYZ) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3546,8 +3471,12 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViXYZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViXYZ))-1 ) = PACK(InData%WindViXYZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViXYZ) + DO i2 = LBOUND(InData%WindViXYZ,2), UBOUND(InData%WindViXYZ,2) + DO i1 = LBOUND(InData%WindViXYZ,1), UBOUND(InData%WindViXYZ,1) + ReKiBuf(Re_Xferred) = InData%WindViXYZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL IfW_UniformWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UniformWind, ErrStat2, ErrMsg2, OnlySize ) ! UniformWind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3717,8 +3646,8 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3773,8 +3702,12 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutParamLinIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutParamLinIndx))-1 ) = PACK(InData%OutParamLinIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutParamLinIndx) + DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) + DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) + IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3819,12 +3752,6 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3840,42 +3767,36 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%RootFileName) - OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CTTS_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PropagationDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootFileName) + OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CTTS_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PropagationDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RotToWind,1) i1_u = UBOUND(OutData%RotToWind,1) i2_l = LBOUND(OutData%RotToWind,2) i2_u = UBOUND(OutData%RotToWind,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RotToWind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotToWind))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotToWind) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RotToWind,2), UBOUND(OutData%RotToWind,2) + DO i1 = LBOUND(OutData%RotToWind,1), UBOUND(OutData%RotToWind,1) + OutData%RotToWind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RotFromWind,1) i1_u = UBOUND(OutData%RotFromWind,1) i2_l = LBOUND(OutData%RotFromWind,2) i2_u = UBOUND(OutData%RotFromWind,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RotFromWind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotFromWind))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotFromWind) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RotFromWind,2), UBOUND(OutData%RotFromWind,2) + DO i1 = LBOUND(OutData%RotFromWind,1), UBOUND(OutData%RotFromWind,1) + OutData%RotFromWind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZprime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3892,22 +3813,19 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViXYZprime)>0) OutData%WindViXYZprime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViXYZprime))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViXYZprime) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViXYZprime,2), UBOUND(OutData%WindViXYZprime,2) + DO i1 = LBOUND(OutData%WindViXYZprime,1), UBOUND(OutData%WindViXYZprime,1) + OutData%WindViXYZprime(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ReferenceHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NWindVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ReferenceHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NWindVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZ not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3924,15 +3842,12 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViXYZ)>0) OutData%WindViXYZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViXYZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViXYZ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViXYZ,2), UBOUND(OutData%WindViXYZ,2) + DO i1 = LBOUND(OutData%WindViXYZ,1), UBOUND(OutData%WindViXYZ,1) + OutData%WindViXYZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4174,8 +4089,8 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4248,15 +4163,12 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutParamLinIndx)>0) OutData%OutParamLinIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutParamLinIndx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutParamLinIndx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) + DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) + OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4448,8 +4360,12 @@ SUBROUTINE InflowWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PositionXYZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PositionXYZ))-1 ) = PACK(InData%PositionXYZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PositionXYZ) + DO i2 = LBOUND(InData%PositionXYZ,2), UBOUND(InData%PositionXYZ,2) + DO i1 = LBOUND(InData%PositionXYZ,1), UBOUND(InData%PositionXYZ,1) + ReKiBuf(Re_Xferred) = InData%PositionXYZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4494,12 +4410,6 @@ SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4531,15 +4441,12 @@ SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PositionXYZ)>0) OutData%PositionXYZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PositionXYZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PositionXYZ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PositionXYZ,2), UBOUND(OutData%PositionXYZ,2) + DO i1 = LBOUND(OutData%PositionXYZ,1), UBOUND(OutData%PositionXYZ,1) + OutData%PositionXYZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4753,8 +4660,12 @@ SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VelocityUVW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VelocityUVW))-1 ) = PACK(InData%VelocityUVW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VelocityUVW) + DO i2 = LBOUND(InData%VelocityUVW,2), UBOUND(InData%VelocityUVW,2) + DO i1 = LBOUND(InData%VelocityUVW,1), UBOUND(InData%VelocityUVW,1) + ReKiBuf(Re_Xferred) = InData%VelocityUVW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4766,11 +4677,15 @@ SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DiskVel))-1 ) = PACK(InData%DiskVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DiskVel) + DO i1 = LBOUND(InData%DiskVel,1), UBOUND(InData%DiskVel,1) + ReKiBuf(Re_Xferred) = InData%DiskVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4814,12 +4729,6 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4851,15 +4760,12 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VelocityUVW)>0) OutData%VelocityUVW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VelocityUVW))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VelocityUVW) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%VelocityUVW,2), UBOUND(OutData%VelocityUVW,2) + DO i1 = LBOUND(OutData%VelocityUVW,1), UBOUND(OutData%VelocityUVW,1) + OutData%VelocityUVW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4874,27 +4780,17 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%DiskVel,1) i1_u = UBOUND(OutData%DiskVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DiskVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DiskVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DiskVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DiskVel,1), UBOUND(OutData%DiskVel,1) + OutData%DiskVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5028,8 +4924,8 @@ SUBROUTINE InflowWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackContState SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5045,12 +4941,6 @@ SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackContState' @@ -5064,8 +4954,8 @@ SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackContState SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5159,8 +5049,8 @@ SUBROUTINE InflowWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackDiscState SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5176,12 +5066,6 @@ SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackDiscState' @@ -5195,8 +5079,8 @@ SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackDiscState SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5290,8 +5174,8 @@ SUBROUTINE InflowWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackConstrState SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5307,12 +5191,6 @@ SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackConstrState' @@ -5326,8 +5204,8 @@ SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackConstrState SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5421,8 +5299,8 @@ SUBROUTINE InflowWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackOtherState SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5438,12 +5316,6 @@ SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackOtherState' @@ -5457,8 +5329,8 @@ SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackOtherState @@ -5536,14 +5408,14 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5556,13 +5428,15 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - ALLOCATE(b2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - ALLOCATE(c2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - b2 = -(u1%PositionXYZ - u2%PositionXYZ)/t(2) - u_out%PositionXYZ = u1%PositionXYZ + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) + DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) + b = -(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -5595,15 +5469,16 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5622,14 +5497,16 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - ALLOCATE(b2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - ALLOCATE(c2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - b2 = (t(3)**2*(u1%PositionXYZ - u2%PositionXYZ) + t(2)**2*(-u1%PositionXYZ + u3%PositionXYZ))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%PositionXYZ + t(3)*u2%PositionXYZ - t(2)*u3%PositionXYZ ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PositionXYZ = u1%PositionXYZ + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) + DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) + b = (t(3)**2*(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + t(2)**2*(-u1%PositionXYZ(i1,i2) + u3%PositionXYZ(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%PositionXYZ(i1,i2) + t(3)*u2%PositionXYZ(i1,i2) - t(2)*u3%PositionXYZ(i1,i2) ) * scaleFactor + u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -5710,14 +5587,14 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5730,28 +5607,26 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - ALLOCATE(b2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - ALLOCATE(c2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - b2 = -(y1%VelocityUVW - y2%VelocityUVW)/t(2) - y_out%VelocityUVW = y1%VelocityUVW + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) + DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) + b = -(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(y_out%DiskVel,1))) - ALLOCATE(c1(SIZE(y_out%DiskVel,1))) - b1 = -(y1%DiskVel - y2%DiskVel)/t(2) - y_out%DiskVel = y1%DiskVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) + b = -(y1%DiskVel(i1) - y2%DiskVel(i1)) + y_out%DiskVel(i1) = y1%DiskVel(i1) + b * ScaleFactor + END DO CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE InflowWind_Output_ExtrapInterp1 @@ -5783,15 +5658,16 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5810,31 +5686,29 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - ALLOCATE(b2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - ALLOCATE(c2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - b2 = (t(3)**2*(y1%VelocityUVW - y2%VelocityUVW) + t(2)**2*(-y1%VelocityUVW + y3%VelocityUVW))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%VelocityUVW + t(3)*y2%VelocityUVW - t(2)*y3%VelocityUVW ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%VelocityUVW = y1%VelocityUVW + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) + DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) + b = (t(3)**2*(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + t(2)**2*(-y1%VelocityUVW(i1,i2) + y3%VelocityUVW(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%VelocityUVW(i1,i2) + t(3)*y2%VelocityUVW(i1,i2) - t(2)*y3%VelocityUVW(i1,i2) ) * scaleFactor + y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(y_out%DiskVel,1))) - ALLOCATE(c1(SIZE(y_out%DiskVel,1))) - b1 = (t(3)**2*(y1%DiskVel - y2%DiskVel) + t(2)**2*(-y1%DiskVel + y3%DiskVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%DiskVel + t(3)*y2%DiskVel - t(2)*y3%DiskVel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DiskVel = y1%DiskVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) + b = (t(3)**2*(y1%DiskVel(i1) - y2%DiskVel(i1)) + t(2)**2*(-y1%DiskVel(i1) + y3%DiskVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%DiskVel(i1) + t(3)*y2%DiskVel(i1) - t(2)*y3%DiskVel(i1) ) * scaleFactor + y_out%DiskVel(i1) = y1%DiskVel(i1) + b + c * t_out + END DO CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE InflowWind_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 88981bcf4c..4ec86f6a34 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -209,18 +209,22 @@ SUBROUTINE Lidar_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPosition))-1 ) = PACK(InData%HubPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPosition) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_PackInitInput SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -236,12 +240,6 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -256,36 +254,26 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubPosition,1) i1_u = UBOUND(OutData%HubPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPosition) - DEALLOCATE(mask1) - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_UnPackInitInput SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -379,8 +367,8 @@ SUBROUTINE Lidar_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInitOut + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackInitOutput SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -396,12 +384,6 @@ SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInitOutput' @@ -415,8 +397,8 @@ SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInitOut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackInitOutput SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -531,28 +513,30 @@ SUBROUTINE Lidar_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RayRangeSq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpatialRes - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtFnTrunc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseRangeOne - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DeltaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DeltaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%r_p - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%RayRangeSq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpatialRes + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtFnTrunc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PulseRangeOne + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DeltaP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DeltaR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%r_p + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_PackParam SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -568,12 +552,6 @@ SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -588,37 +566,32 @@ SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) - OutData%RayRangeSq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpatialRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtFnTrunc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PulseRangeOne = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%r_p = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%RayRangeSq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpatialRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtFnTrunc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PulseRangeOne = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DeltaP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DeltaR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%r_p = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_UnPackParam SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -712,8 +685,8 @@ SUBROUTINE Lidar_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackContState SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -729,12 +702,6 @@ SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackContState' @@ -748,8 +715,8 @@ SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackContState SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -843,8 +810,8 @@ SUBROUTINE Lidar_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackDiscState SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -860,12 +827,6 @@ SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackDiscState' @@ -879,8 +840,8 @@ SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackDiscState SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -974,8 +935,8 @@ SUBROUTINE Lidar_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackConstrState SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -991,12 +952,6 @@ SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackConstrState' @@ -1010,8 +965,8 @@ SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackConstrState SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1105,8 +1060,8 @@ SUBROUTINE Lidar_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackOtherState SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1122,12 +1077,6 @@ SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackOtherState' @@ -1141,8 +1090,8 @@ SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackOtherState SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1236,8 +1185,8 @@ SUBROUTINE Lidar_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackMisc SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1253,12 +1202,6 @@ SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackMisc' @@ -1272,8 +1215,8 @@ SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackMisc SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1374,14 +1317,18 @@ SUBROUTINE Lidar_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidPosition))-1 ) = PACK(InData%LidPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MsrPosition))-1 ) = PACK(InData%MsrPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MsrPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseLidEl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseLidAz - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidPosition,1), UBOUND(InData%LidPosition,1) + ReKiBuf(Re_Xferred) = InData%LidPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MsrPosition,1), UBOUND(InData%MsrPosition,1) + ReKiBuf(Re_Xferred) = InData%MsrPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%PulseLidEl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PulseLidAz + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackInput SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1397,12 +1344,6 @@ SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1419,30 +1360,20 @@ SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%LidPosition,1) i1_u = UBOUND(OutData%LidPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LidPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidPosition,1), UBOUND(OutData%LidPosition,1) + OutData%LidPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MsrPosition,1) i1_u = UBOUND(OutData%MsrPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MsrPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MsrPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MsrPosition) - DEALLOCATE(mask1) - OutData%PulseLidEl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PulseLidAz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%MsrPosition,1), UBOUND(OutData%MsrPosition,1) + OutData%MsrPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%PulseLidEl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PulseLidAz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackInput SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1585,8 +1516,10 @@ SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LidSpeed)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidSpeed))-1 ) = PACK(InData%LidSpeed,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidSpeed) + DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) + ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WtTrunc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1598,8 +1531,10 @@ SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WtTrunc,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WtTrunc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WtTrunc))-1 ) = PACK(InData%WtTrunc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WtTrunc) + DO i1 = LBOUND(InData%WtTrunc,1), UBOUND(InData%WtTrunc,1) + ReKiBuf(Re_Xferred) = InData%WtTrunc(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Lidar_PackOutput @@ -1616,12 +1551,6 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1649,15 +1578,10 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LidSpeed)>0) OutData%LidSpeed = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidSpeed))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidSpeed) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) + OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WtTrunc not allocated Int_Xferred = Int_Xferred + 1 @@ -1672,15 +1596,10 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WtTrunc)>0) OutData%WtTrunc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WtTrunc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WtTrunc) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WtTrunc,1), UBOUND(OutData%WtTrunc,1) + OutData%WtTrunc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Lidar_UnPackOutput @@ -1759,12 +1678,12 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1777,22 +1696,20 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%LidPosition,1))) - ALLOCATE(c1(SIZE(u_out%LidPosition,1))) - b1 = -(u1%LidPosition - u2%LidPosition)/t(2) - u_out%LidPosition = u1%LidPosition + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%MsrPosition,1))) - ALLOCATE(c1(SIZE(u_out%MsrPosition,1))) - b1 = -(u1%MsrPosition - u2%MsrPosition)/t(2) - u_out%MsrPosition = u1%MsrPosition + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%PulseLidEl - u2%PulseLidEl)/t(2) - u_out%PulseLidEl = u1%PulseLidEl + b0 * t_out - b0 = -(u1%PulseLidAz - u2%PulseLidAz)/t(2) - u_out%PulseLidAz = u1%PulseLidAz + b0 * t_out + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%LidPosition,1),UBOUND(u_out%LidPosition,1) + b = -(u1%LidPosition(i1) - u2%LidPosition(i1)) + u_out%LidPosition(i1) = u1%LidPosition(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%MsrPosition,1),UBOUND(u_out%MsrPosition,1) + b = -(u1%MsrPosition(i1) - u2%MsrPosition(i1)) + u_out%MsrPosition(i1) = u1%MsrPosition(i1) + b * ScaleFactor + END DO + b = -(u1%PulseLidEl - u2%PulseLidEl) + u_out%PulseLidEl = u1%PulseLidEl + b * ScaleFactor + b = -(u1%PulseLidAz - u2%PulseLidAz) + u_out%PulseLidAz = u1%PulseLidAz + b * ScaleFactor END SUBROUTINE Lidar_Input_ExtrapInterp1 @@ -1822,13 +1739,14 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1847,26 +1765,24 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%LidPosition,1))) - ALLOCATE(c1(SIZE(u_out%LidPosition,1))) - b1 = (t(3)**2*(u1%LidPosition - u2%LidPosition) + t(2)**2*(-u1%LidPosition + u3%LidPosition))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%LidPosition + t(3)*u2%LidPosition - t(2)*u3%LidPosition ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LidPosition = u1%LidPosition + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%MsrPosition,1))) - ALLOCATE(c1(SIZE(u_out%MsrPosition,1))) - b1 = (t(3)**2*(u1%MsrPosition - u2%MsrPosition) + t(2)**2*(-u1%MsrPosition + u3%MsrPosition))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%MsrPosition + t(3)*u2%MsrPosition - t(2)*u3%MsrPosition ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%MsrPosition = u1%MsrPosition + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PulseLidEl = u1%PulseLidEl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PulseLidAz = u1%PulseLidAz + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%LidPosition,1),UBOUND(u_out%LidPosition,1) + b = (t(3)**2*(u1%LidPosition(i1) - u2%LidPosition(i1)) + t(2)**2*(-u1%LidPosition(i1) + u3%LidPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%LidPosition(i1) + t(3)*u2%LidPosition(i1) - t(2)*u3%LidPosition(i1) ) * scaleFactor + u_out%LidPosition(i1) = u1%LidPosition(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%MsrPosition,1),UBOUND(u_out%MsrPosition,1) + b = (t(3)**2*(u1%MsrPosition(i1) - u2%MsrPosition(i1)) + t(2)**2*(-u1%MsrPosition(i1) + u3%MsrPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%MsrPosition(i1) + t(3)*u2%MsrPosition(i1) - t(2)*u3%MsrPosition(i1) ) * scaleFactor + u_out%MsrPosition(i1) = u1%MsrPosition(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))* scaleFactor + c = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) * scaleFactor + u_out%PulseLidEl = u1%PulseLidEl + b + c * t_out + b = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))* scaleFactor + c = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) * scaleFactor + u_out%PulseLidAz = u1%PulseLidAz + b + c * t_out END SUBROUTINE Lidar_Input_ExtrapInterp2 @@ -1944,12 +1860,12 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1962,21 +1878,19 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - ALLOCATE(b1(SIZE(y_out%LidSpeed,1))) - ALLOCATE(c1(SIZE(y_out%LidSpeed,1))) - b1 = -(y1%LidSpeed - y2%LidSpeed)/t(2) - y_out%LidSpeed = y1%LidSpeed + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) + b = -(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - ALLOCATE(b1(SIZE(y_out%WtTrunc,1))) - ALLOCATE(c1(SIZE(y_out%WtTrunc,1))) - b1 = -(y1%WtTrunc - y2%WtTrunc)/t(2) - y_out%WtTrunc = y1%WtTrunc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) + b = -(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Lidar_Output_ExtrapInterp1 @@ -2007,13 +1921,14 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2032,23 +1947,21 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - ALLOCATE(b1(SIZE(y_out%LidSpeed,1))) - ALLOCATE(c1(SIZE(y_out%LidSpeed,1))) - b1 = (t(3)**2*(y1%LidSpeed - y2%LidSpeed) + t(2)**2*(-y1%LidSpeed + y3%LidSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%LidSpeed + t(3)*y2%LidSpeed - t(2)*y3%LidSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LidSpeed = y1%LidSpeed + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) + b = (t(3)**2*(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + t(2)**2*(-y1%LidSpeed(i1) + y3%LidSpeed(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%LidSpeed(i1) + t(3)*y2%LidSpeed(i1) - t(2)*y3%LidSpeed(i1) ) * scaleFactor + y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - ALLOCATE(b1(SIZE(y_out%WtTrunc,1))) - ALLOCATE(c1(SIZE(y_out%WtTrunc,1))) - b1 = (t(3)**2*(y1%WtTrunc - y2%WtTrunc) + t(2)**2*(-y1%WtTrunc + y3%WtTrunc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WtTrunc + t(3)*y2%WtTrunc - t(2)*y3%WtTrunc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WtTrunc = y1%WtTrunc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) + b = (t(3)**2*(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + t(2)**2*(-y1%WtTrunc(i1) + y3%WtTrunc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WtTrunc(i1) + t(3)*y2%WtTrunc(i1) - t(2)*y3%WtTrunc(i1) ) * scaleFactor + y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Lidar_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/OutListParameters.xlsx b/modules/inflowwind/src/OutListParameters.xlsx deleted file mode 100644 index e82c023bad..0000000000 Binary files a/modules/inflowwind/src/OutListParameters.xlsx and /dev/null differ diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index b780022356..d1d73bfc1c 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -21,12 +21,14 @@ endif() if (GENERATE_TYPES) generate_f90_types(src/MAP_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Types.f90 -ccode) + generate_f90_types(src/MAP_Fortran_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MAP_Fortran_Types.f90 -noextrap) endif() file(GLOB MAP_CLIB_SOURCES src/*.c src/*.cc src/*/*.c src/*/*.cc) file(GLOB MAP_C_HEADERS src/*.h src/*/*.h) -add_library(mapcpplib ${MAP_CLIB_SOURCES} src/MAP_Types.f90) +add_library(mapcpplib ${MAP_CLIB_SOURCES} src/MAP_Types.f90 src/MAP_Fortran_Types.f90) + target_include_directories(mapcpplib PUBLIC $ $ @@ -38,6 +40,7 @@ target_link_libraries(mapcpplib nwtclibs) add_library(maplib src/map.f90 src/MAP_Types.f90 + src/MAP_Fortran_Types.f90 ) target_link_libraries(maplib mapcpplib) diff --git a/modules/map/src/MAP_Fortran_Registry.txt b/modules/map/src/MAP_Fortran_Registry.txt new file mode 100644 index 0000000000..b1ad941a80 --- /dev/null +++ b/modules/map/src/MAP_Fortran_Registry.txt @@ -0,0 +1,22 @@ +################## Registry for MAP++ ############### +# column 1 +# column 2 ModuleName/ModName or ^ to use the value from the previous line (SD is nickname for ModuleName) +# column 3 Derived data type (without "ModName_" prefix) +# column 4 Derived data types's Field type +# column 5 Variable name +# column 6 Dimension of variable {:} for allocatable +# column 7 Variable's initial value (if set in the data type) +# column 8 I think this is a switch for mixed-language programming; it's mostly unused +# column 9 Description +# column 10 Units +# Keyword ModuleName/ModName Derived data type Field type Variable name variable dimension Initial value for mix language, not used Description Units + +include Registry_NWTC_Library.txt + +typedef MAP_Fortran/MAP_Fortran Lin_InitInputType LOGICAL linearize - .false. - "Flag that tells this module if the glue code wants to linearize. (fortran-only)" - +typedef ^ Lin_InitOutputType CHARACTER(200) LinNames_y {:} "" - "second line of output file contents: units (fortran-only)" - +typedef ^ ^ CHARACTER(200) LinNames_u {:} "" - "Names of the inputs used in linearization (fortran-only)" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) (fortran-only)" - +typedef ^ Lin_ParamType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian (fortran-only)" - +typedef ^ ^ R8Ki du - - - "determines size of the translational displacement perturbation for u (inputs) (fortran-only)" - +typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix (fortran-only)" - diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 new file mode 100644 index 0000000000..47c34ab7c1 --- /dev/null +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -0,0 +1,674 @@ +!STARTOFREGISTRYGENERATEDFILE 'MAP_Fortran_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! MAP_Fortran_Types +!................................................................................................................................. +! This file is part of MAP_Fortran. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in MAP_Fortran. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE MAP_Fortran_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Lin_InitInputType ======= + TYPE, PUBLIC :: Lin_InitInputType + LOGICAL :: linearize = .false. !< Flag that tells this module if the glue code wants to linearize. (fortran-only) [-] + END TYPE Lin_InitInputType +! ======================= +! ========= Lin_InitOutputType ======= + TYPE, PUBLIC :: Lin_InitOutputType + CHARACTER(200) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< second line of output file contents: units (fortran-only) [-] + CHARACTER(200) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization (fortran-only) [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) (fortran-only) [-] + END TYPE Lin_InitOutputType +! ======================= +! ========= Lin_ParamType ======= + TYPE, PUBLIC :: Lin_ParamType + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian (fortran-only) [-] + REAL(R8Ki) :: du !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] + INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix (fortran-only) [-] + END TYPE Lin_ParamType +! ======================= +CONTAINS + SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Lin_InitInputType), INTENT(IN) :: SrcLin_InitInputTypeData + TYPE(Lin_InitInputType), INTENT(INOUT) :: DstLin_InitInputTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize + END SUBROUTINE MAP_Fortran_CopyLin_InitInputType + + SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrMsg ) + TYPE(Lin_InitInputType), INTENT(INOUT) :: Lin_InitInputTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MAP_Fortran_DestroyLin_InitInputType + + SUBROUTINE MAP_Fortran_PackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Lin_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! linearize + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = TRANSFER(InData%linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MAP_Fortran_PackLin_InitInputType + + SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Lin_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%linearize) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MAP_Fortran_UnPackLin_InitInputType + + SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Lin_InitOutputType), INTENT(IN) :: SrcLin_InitOutputTypeData + TYPE(Lin_InitOutputType), INTENT(INOUT) :: DstLin_InitOutputTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_y)) THEN + i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) + i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) + IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_y)) THEN + ALLOCATE(DstLin_InitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y +ENDIF +IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_u)) THEN + i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) + i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) + IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_u)) THEN + ALLOCATE(DstLin_InitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u +ENDIF +IF (ALLOCATED(SrcLin_InitOutputTypeData%IsLoad_u)) THEN + i1_l = LBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) + i1_u = UBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%IsLoad_u)) THEN + ALLOCATE(DstLin_InitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u +ENDIF + END SUBROUTINE MAP_Fortran_CopyLin_InitOutputType + + SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrStat, ErrMsg ) + TYPE(Lin_InitOutputType), INTENT(INOUT) :: Lin_InitOutputTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_y)) THEN + DEALLOCATE(Lin_InitOutputTypeData%LinNames_y) +ENDIF +IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_u)) THEN + DEALLOCATE(Lin_InitOutputTypeData%LinNames_u) +ENDIF +IF (ALLOCATED(Lin_InitOutputTypeData%IsLoad_u)) THEN + DEALLOCATE(Lin_InitOutputTypeData%IsLoad_u) +ENDIF + END SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType + + SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Lin_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no + IF ( ALLOCATED(InData%LinNames_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no + IF ( ALLOCATED(InData%LinNames_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO I = 1, LEN(InData%LinNames_y) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO I = 1, LEN(InData%LinNames_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE MAP_Fortran_PackLin_InitOutputType + + SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Lin_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) + ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO I = 1, LEN(OutData%LinNames_y) + OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) + ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO I = 1, LEN(OutData%LinNames_u) + OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType + + SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Lin_ParamType), INTENT(IN) :: SrcLin_ParamTypeData + TYPE(Lin_ParamType), INTENT(INOUT) :: DstLin_ParamTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcLin_ParamTypeData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) + i1_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) + i2_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) + i2_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstLin_ParamTypeData%Jac_u_indx)) THEN + ALLOCATE(DstLin_ParamTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx +ENDIF + DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du + DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny + END SUBROUTINE MAP_Fortran_CopyLin_ParamType + + SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg ) + TYPE(Lin_ParamType), INTENT(INOUT) :: Lin_ParamTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(Lin_ParamTypeData%Jac_u_indx)) THEN + DEALLOCATE(Lin_ParamTypeData%Jac_u_indx) +ENDIF + END SUBROUTINE MAP_Fortran_DestroyLin_ParamType + + SUBROUTINE MAP_Fortran_PackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Lin_ParamType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_PackLin_ParamType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no + IF ( ALLOCATED(InData%Jac_u_indx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx + END IF + Db_BufSz = Db_BufSz + 1 ! du + Int_BufSz = Int_BufSz + 1 ! Jac_ny + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%du + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MAP_Fortran_PackLin_ParamType + + SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Lin_ParamType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%du = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MAP_Fortran_UnPackLin_ParamType + +END MODULE MAP_Fortran_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Registry.txt b/modules/map/src/MAP_Registry.txt index 37c4c93147..705ad34c04 100644 --- a/modules/map/src/MAP_Registry.txt +++ b/modules/map/src/MAP_Registry.txt @@ -1,39 +1,39 @@ -################## Registry for MAP++ ############### -# column 1 -# column 2 ModuleName/ModName or ^ to use the value from the previous line (SD is nickname for ModuleName) -# column 3 Derived data type (without "ModName_" prefix) -# column 4 Derived data types's Field type -# column 5 Variable name -# column 6 Dimension of variable {:} for allocatable -# column 7 Variable's initial value (if set in the data type) -# column 8 I think this is a switch for mixed-language programming; it's mostly unused -# column 9 Description -# column 10 Units -# Keyword ModuleName/ModName Derived data type Field type Variable name variable dimension Initial value for mix language, not used Description Units +################## Registry for MAP++ ############### +# column 1 +# column 2 ModuleName/ModName or ^ to use the value from the previous line (SD is nickname for ModuleName) +# column 3 Derived data type (without "ModName_" prefix) +# column 4 Derived data types's Field type +# column 5 Variable name +# column 6 Dimension of variable {:} for allocatable +# column 7 Variable's initial value (if set in the data type) +# column 8 I think this is a switch for mixed-language programming; it's mostly unused +# column 9 Description +# column 10 Units +# Keyword ModuleName/ModName Derived data type Field type Variable name variable dimension Initial value for mix language, not used Description Units + include Registry_NWTC_Library.txt +usefrom MAP_Fortran_Registry.txt - -## ============================== Define input types here: ============================================================================================================================================ -typedef MAP InitInputType DbKi gravity - -999.9 - "gravity constant" "[m/s^2]" +## ============================== Define input types here: ============================================================================================================================================ +typedef MAP InitInputType DbKi gravity - -999.9 - "gravity constant" "[m/s^2]" typedef ^ ^ DbKi sea_density - -999.9 - "sea density" "[kg/m^3]" -typedef ^ ^ DbKi depth - -999.9 - "depth of water" "[m]" -typedef ^ ^ CHARACTER(255) file_name - "" - "MAP input file" -typedef ^ ^ CHARACTER(255) summary_file_name - "" - "MAP summary file name" -typedef ^ ^ CHARACTER(255) library_input_str - "" - "cable library string information (from input file)" -typedef ^ ^ CHARACTER(255) node_input_str - "" - "node string information (from input file)" -typedef ^ ^ CHARACTER(255) line_input_str - "" - "element library string information (from input file)" -typedef ^ ^ CHARACTER(255) option_input_str - "" - "solver options library string information (from input file)" - - +typedef ^ ^ DbKi depth - -999.9 - "depth of water" "[m]" +typedef ^ ^ CHARACTER(255) file_name - "" - "MAP input file" +typedef ^ ^ CHARACTER(255) summary_file_name - "" - "MAP summary file name" +typedef ^ ^ CHARACTER(255) library_input_str - "" - "cable library string information (from input file)" +typedef ^ ^ CHARACTER(255) node_input_str - "" - "node string information (from input file)" +typedef ^ ^ CHARACTER(255) line_input_str - "" - "element library string information (from input file)" +typedef ^ ^ CHARACTER(255) option_input_str - "" - "solver options library string information (from input file)" +typedef ^ ^ Lin_InitInputType LinInitInp - - - " " - ## ============================== Define Initialization outputs here: ================================================================================================================================ typedef ^ InitOutputType CHARACTER(99) progName - "" - "program name" -typedef ^ ^ CHARACTER(99) version - "" - "version numnber" +typedef ^ ^ CHARACTER(99) version - "" - "version numnber" typedef ^ ^ CHARACTER(24) compilingData - "" - "compiling data" -typedef ^ ^ CHARACTER(10) writeOutputHdr {:} "" - "first line output file contents: output variable names" -typedef ^ ^ CHARACTER(10) writeOutputUnt {:} "" - "second line of output file contents: units" -typedef ^ ^ ProgDesc Ver - "" - "his module's name, version, and date" - +typedef ^ ^ CHARACTER(15) writeOutputHdr {:} "" - "first line output file contents: output variable names" +typedef ^ ^ CHARACTER(15) writeOutputUnt {:} "" - "second line of output file contents: units" +typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" +typedef ^ ^ Lin_InitOutputType LinInitOut - - - "Init Output linearization data (fortran-only)" - ## ============================== Define Continuous states here: ===================================================================================================================================== typedef ^ ContinuousStateType DbKI dummy - - - "Remove this variable if you have continuous states" - @@ -44,30 +44,30 @@ typedef ^ DiscreteStateType DbKi dummy ## ============================== Define Other states here: ===================================================================================================================================== -typedef ^ OtherStateType DbKi H {:} - - "horizontal line force" "[N]" -typedef ^ ^ DbKi V {:} - - "Vertical line force" "[N]" -typedef ^ ^ DbKi Ha {:} - - "horizontal line force at anchor" "[N]" -typedef ^ ^ DbKi Va {:} - - "Vertical line force at anchor" "[N]" -typedef ^ ^ DbKi x {:} - - "x fairlead line position" "[m]" -typedef ^ ^ DbKi y {:} - - "y fairlead line position" "[m]" -typedef ^ ^ DbKi z {:} - - "z fairlead line position" "[m]" -typedef ^ ^ DbKi xa {:} - - "x fairlead line position at anchor" "[m]" -typedef ^ ^ DbKi ya {:} - - "y fairlead line position at anchor" "[m]" -typedef ^ ^ DbKi za {:} - - "z fairlead line position at anchor" "[m]" -typedef ^ ^ DbKi Fx_connect {:} - - "horizontal x line force at connect node" "[N]" -typedef ^ ^ DbKi Fy_connect {:} - - "horizontal y line force at connect node" "[N]" -typedef ^ ^ DbKi Fz_connect {:} - - "vertical z line force at connect node" "[N]" -typedef ^ ^ DbKi Fx_anchor {:} - - "horizontal x line force at connect node" "[N]" -typedef ^ ^ DbKi Fy_anchor {:} - - "horizontal y line force at connect node" "[N]" -typedef ^ ^ DbKi Fz_anchor {:} - - "vertical z line force at connect node" "[N]" +typedef ^ OtherStateType DbKi H {:} - - "horizontal line force" "[N]" +typedef ^ ^ DbKi V {:} - - "Vertical line force" "[N]" +typedef ^ ^ DbKi Ha {:} - - "horizontal line force at anchor" "[N]" +typedef ^ ^ DbKi Va {:} - - "Vertical line force at anchor" "[N]" +typedef ^ ^ DbKi x {:} - - "x fairlead line position" "[m]" +typedef ^ ^ DbKi y {:} - - "y fairlead line position" "[m]" +typedef ^ ^ DbKi z {:} - - "z fairlead line position" "[m]" +typedef ^ ^ DbKi xa {:} - - "x fairlead line position at anchor" "[m]" +typedef ^ ^ DbKi ya {:} - - "y fairlead line position at anchor" "[m]" +typedef ^ ^ DbKi za {:} - - "z fairlead line position at anchor" "[m]" +typedef ^ ^ DbKi Fx_connect {:} - - "horizontal x line force at connect node" "[N]" +typedef ^ ^ DbKi Fy_connect {:} - - "horizontal y line force at connect node" "[N]" +typedef ^ ^ DbKi Fz_connect {:} - - "vertical z line force at connect node" "[N]" +typedef ^ ^ DbKi Fx_anchor {:} - - "horizontal x line force at connect node" "[N]" +typedef ^ ^ DbKi Fy_anchor {:} - - "horizontal y line force at connect node" "[N]" +typedef ^ ^ DbKi Fz_anchor {:} - - "vertical z line force at connect node" "[N]" ## ============================== Define constraint states here: ===================================================================================================================================== -typedef ^ ConstraintStateType DbKi H {:} - - "horizontal line force" "[N]" -typedef ^ ^ DbKi V {:} - - "Vertical line force" "[N]" -typedef ^ ^ DbKi x {:} - - "fairlead x displacement" "[m]" -typedef ^ ^ DbKi y {:} - - "fairlead y displacement" "[m]" -typedef ^ ^ DbKi z {:} - - "fairlead z displacement" "[m]" +typedef ^ ConstraintStateType DbKi H {:} - - "horizontal line force" "[N]" +typedef ^ ^ DbKi V {:} - - "Vertical line force" "[N]" +typedef ^ ^ DbKi x {:} - - "fairlead x displacement" "[m]" +typedef ^ ^ DbKi y {:} - - "fairlead y displacement" "[m]" +typedef ^ ^ DbKi z {:} - - "fairlead z displacement" "[m]" ## ============================== Parameters ============================================================================================================================================ @@ -82,21 +82,23 @@ typedef ^ ^ DbKi dt #typedef ^ ^ DbKi mu - - - "cable mass denity" "[kg/m]" typedef ^ ^ CHARACTER(255) InputLines {500} - - "input file line for restart" typedef ^ ^ CHARACTER(1) InputLineType {500} - - "input file line type for restart" +typedef ^ ^ INTEGER numOuts - 0 - "Number of write outputs" - +typedef ^ ^ Lin_ParamType LinParams - - - "Parameter linearization data (fortran-only)" - -# ============================== Inputs ============================================================================================================================================ -typedef ^ InputType DbKi x {:} - - "fairlead x displacement" "[m]" -typedef ^ ^ DbKi y {:} - - "fairlead y displacement" "[m]" -typedef ^ ^ DbKi z {:} - - "fairlead z displacement" "[m]" -typedef ^ ^ MeshType PtFairDisplacement - - - "position of each fairlead in X,Y,Z" "[m]" +# ============================== Inputs ============================================================================================================================================ +typedef ^ InputType DbKi x {:} - - "fairlead x displacement" "[m]" +typedef ^ ^ DbKi y {:} - - "fairlead y displacement" "[m]" +typedef ^ ^ DbKi z {:} - - "fairlead z displacement" "[m]" +typedef ^ ^ MeshType PtFairDisplacement - - - "position of each fairlead in X,Y,Z" "[m]" ## ============================== Outputs ============================================================================================================================================ -typedef ^ OutputType DbKi Fx {:} - - "horizontal line force" "[N]" -typedef ^ ^ DbKi Fy {:} - - "Vertical line force" "[N]" -typedef ^ ^ DbKi Fz {:} - - "horizontal line force at anchor" "[N]" -typedef ^ ^ ReKi WriteOutput {:} - - "outpur vector" "" -typedef ^ ^ DbKi wrtOutput {:} - - "outpur vector" "" -typedef ^ ^ MeshType ptFairleadLoad - - - "point mesh for forces in X,Y,Z" "[N]" +typedef ^ OutputType DbKi Fx {:} - - "horizontal line force" "[N]" +typedef ^ ^ DbKi Fy {:} - - "Vertical line force" "[N]" +typedef ^ ^ DbKi Fz {:} - - "horizontal line force at anchor" "[N]" +typedef ^ ^ ReKi WriteOutput {:} - - "outpur vector" "" +typedef ^ ^ DbKi wrtOutput {:} - - "outpur vector" "" +typedef ^ ^ MeshType ptFairleadLoad - - - "point mesh for forces in X,Y,Z" "[N]" ##################################################################################################################################### diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index ab8906ac65..1b15b8f331 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE MAP_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE MAP_Fortran_Types !USE, INTRINSIC :: ISO_C_Binding USE NWTC_Library IMPLICIT NONE @@ -58,6 +59,7 @@ MODULE MAP_Types CHARACTER(255) :: node_input_str !< node string information (from input file) [-] CHARACTER(255) :: line_input_str !< element library string information (from input file) [-] CHARACTER(255) :: option_input_str !< solver options library string information (from input file) [-] + TYPE(Lin_InitInputType) :: LinInitInp !< [-] END TYPE MAP_InitInputType ! ======================= ! ========= MAP_InitOutputType_C ======= @@ -76,9 +78,10 @@ MODULE MAP_Types CHARACTER(99) :: progName !< program name [-] CHARACTER(99) :: version !< version numnber [-] CHARACTER(24) :: compilingData !< compiling data [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] - TYPE(ProgDesc) :: Ver !< his module's name, version, and date [-] + CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] + CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] + TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] + TYPE(Lin_InitOutputType) :: LinInitOut !< Init Output linearization data (fortran-only) [-] END TYPE MAP_InitOutputType ! ======================= ! ========= MAP_ContinuousStateType_C ======= @@ -187,6 +190,7 @@ MODULE MAP_Types REAL(KIND=C_DOUBLE) :: depth REAL(KIND=C_DOUBLE) :: rho_sea REAL(KIND=C_DOUBLE) :: dt + INTEGER(KIND=C_INT) :: numOuts END TYPE MAP_ParameterType_C TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj @@ -196,6 +200,8 @@ MODULE MAP_Types REAL(DbKi) :: dt !< time step coupling interval [[sec]] CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] + INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] + TYPE(Lin_ParamType) :: LinParams !< Parameter linearization data (fortran-only) [-] END TYPE MAP_ParameterType ! ======================= ! ========= MAP_InputType_C ======= @@ -274,6 +280,9 @@ SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str DstInitInputData%option_input_str = SrcInitInputData%option_input_str DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str + CALL MAP_Fortran_Copylin_initinputtype( SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInitInput SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -285,6 +294,7 @@ SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" + CALL MAP_Fortran_Destroylin_initinputtype( InitInputData%LinInitInp, ErrStat, ErrMsg ) END SUBROUTINE MAP_DestroyInitInput SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -331,6 +341,24 @@ SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 1*LEN(InData%node_input_str) ! node_input_str Int_BufSz = Int_BufSz + 1*LEN(InData%line_input_str) ! line_input_str Int_BufSz = Int_BufSz + 1*LEN(InData%option_input_str) ! option_input_str + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! LinInitInp: size of buffers for each call to pack subtype + CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LinInitInp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LinInitInp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LinInitInp + 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 @@ -360,36 +388,64 @@ SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%gravity - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%sea_density - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%depth - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%summary_file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%library_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%node_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%line_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%option_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%gravity + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%sea_density + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%depth + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%file_name) + IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%summary_file_name) + IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%library_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%node_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%line_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%option_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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 MAP_PackInitInput SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -405,12 +461,6 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -425,54 +475,102 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%gravity = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%gravity = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%gravity = OutData%gravity - OutData%sea_density = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%sea_density = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%sea_density = OutData%sea_density - OutData%depth = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%depth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%depth = OutData%depth - DO I = 1, LEN(OutData%file_name) - OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%file_name) + OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%file_name = TRANSFER(OutData%file_name, OutData%C_obj%file_name ) - DO I = 1, LEN(OutData%summary_file_name) - OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%summary_file_name) + OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%summary_file_name = TRANSFER(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - DO I = 1, LEN(OutData%library_input_str) - OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%library_input_str) + OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%library_input_str = TRANSFER(OutData%library_input_str, OutData%C_obj%library_input_str ) - DO I = 1, LEN(OutData%node_input_str) - OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%node_input_str) + OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%node_input_str = TRANSFER(OutData%node_input_str, OutData%C_obj%node_input_str ) - DO I = 1, LEN(OutData%line_input_str) - OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%line_input_str) + OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%line_input_str = TRANSFER(OutData%line_input_str, OutData%C_obj%line_input_str ) - DO I = 1, LEN(OutData%option_input_str) - OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%option_input_str) + OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%option_input_str = TRANSFER(OutData%option_input_str, OutData%C_obj%option_input_str ) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_Fortran_Unpacklin_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitInp, ErrStat2, ErrMsg2 ) ! LinInitInp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInitInput - SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitInputData%gravity = InitInputData%C_obj%gravity InitInputData%sea_density = InitInputData%C_obj%sea_density InitInputData%depth = InitInputData%C_obj%depth @@ -484,6 +582,32 @@ SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) END SUBROUTINE MAP_C2Fary_CopyInitInput + SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%gravity = InitInputData%gravity + InitInputData%C_obj%sea_density = InitInputData%sea_density + InitInputData%C_obj%depth = InitInputData%depth + InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name ) + InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name ) + InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str ) + InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str ) + InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str ) + InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str ) + END SUBROUTINE MAP_F2C_CopyInitInput + SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(MAP_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -532,6 +656,9 @@ SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_Fortran_Copylin_initoutputtype( SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInitOutput SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) @@ -550,6 +677,7 @@ SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) DEALLOCATE(InitOutputData%writeOutputUnt) ENDIF CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) + CALL MAP_Fortran_Destroylin_initoutputtype( InitOutputData%LinInitOut, ErrStat, ErrMsg ) END SUBROUTINE MAP_DestroyInitOutput SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -618,6 +746,23 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! LinInitOut: size of buffers for each call to pack subtype + CALL MAP_Fortran_Packlin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitOut + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LinInitOut + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LinInitOut + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LinInitOut + 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 @@ -647,18 +792,18 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%progName) - IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%version) - IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%compilingData) - IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%progName) + IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%version) + IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%compilingData) + IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -669,12 +814,12 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -686,12 +831,12 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -721,6 +866,34 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL MAP_Fortran_Packlin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, OnlySize ) ! LinInitOut + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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 MAP_PackInitOutput SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -736,12 +909,6 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -756,20 +923,20 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%progName) - OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%progName) + OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%progName = TRANSFER(OutData%progName, OutData%C_obj%progName ) - DO I = 1, LEN(OutData%version) - OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%version) + OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%version = TRANSFER(OutData%version, OutData%C_obj%version ) - DO I = 1, LEN(OutData%compilingData) - OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%compilingData) + OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%compilingData = TRANSFER(OutData%compilingData, OutData%C_obj%compilingData ) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated Int_Xferred = Int_Xferred + 1 @@ -784,19 +951,12 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -811,19 +971,12 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -865,20 +1018,88 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_Fortran_Unpacklin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitOut, ErrStat2, ErrMsg2 ) ! LinInitOut + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInitOutput - SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) END SUBROUTINE MAP_C2Fary_CopyInitOutput + SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName ) + InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version ) + InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) + END SUBROUTINE MAP_F2C_CopyInitOutput + SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -973,8 +1194,8 @@ SUBROUTINE MAP_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dummy - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dummy + Db_Xferred = Db_Xferred + 1 END SUBROUTINE MAP_PackContState SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -990,12 +1211,6 @@ SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackContState' @@ -1009,21 +1224,47 @@ SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dummy = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dummy = OutData%dummy END SUBROUTINE MAP_UnPackContState - SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ContStateData%dummy = ContStateData%C_obj%dummy END SUBROUTINE MAP_C2Fary_CopyContState + SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%dummy = ContStateData%dummy + END SUBROUTINE MAP_F2C_CopyContState + SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1118,8 +1359,8 @@ SUBROUTINE MAP_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dummy - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dummy + Db_Xferred = Db_Xferred + 1 END SUBROUTINE MAP_PackDiscState SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1135,12 +1376,6 @@ SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackDiscState' @@ -1154,21 +1389,47 @@ SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dummy = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dummy = OutData%dummy END SUBROUTINE MAP_UnPackDiscState - SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF DiscStateData%dummy = DiscStateData%C_obj%dummy END SUBROUTINE MAP_C2Fary_CopyDiscState + SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + DiscStateData%C_obj%dummy = DiscStateData%dummy + END SUBROUTINE MAP_F2C_CopyDiscState + SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(MAP_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1687,8 +1948,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%H)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%H))-1 ) = PACK(InData%H,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%H) + DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) + DbKiBuf(Db_Xferred) = InData%H(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1700,8 +1963,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Ha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1713,8 +1978,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ha)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ha))-1 ) = PACK(InData%Ha,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ha) + DO i1 = LBOUND(InData%Ha,1), UBOUND(InData%Ha,1) + DbKiBuf(Db_Xferred) = InData%Ha(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Va) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1726,8 +1993,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Va,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Va)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Va))-1 ) = PACK(InData%Va,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Va) + DO i1 = LBOUND(InData%Va,1), UBOUND(InData%Va,1) + DbKiBuf(Db_Xferred) = InData%Va(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1739,8 +2008,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1752,8 +2023,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1765,8 +2038,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%xa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1778,8 +2053,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xa,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%xa))-1 ) = PACK(InData%xa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%xa) + DO i1 = LBOUND(InData%xa,1), UBOUND(InData%xa,1) + DbKiBuf(Db_Xferred) = InData%xa(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%ya) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1791,8 +2068,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ya,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ya)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ya))-1 ) = PACK(InData%ya,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ya) + DO i1 = LBOUND(InData%ya,1), UBOUND(InData%ya,1) + DbKiBuf(Db_Xferred) = InData%ya(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%za) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1804,8 +2083,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%za,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%za)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%za))-1 ) = PACK(InData%za,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%za) + DO i1 = LBOUND(InData%za,1), UBOUND(InData%za,1) + DbKiBuf(Db_Xferred) = InData%za(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fx_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1817,8 +2098,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx_connect))-1 ) = PACK(InData%Fx_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx_connect) + DO i1 = LBOUND(InData%Fx_connect,1), UBOUND(InData%Fx_connect,1) + DbKiBuf(Db_Xferred) = InData%Fx_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1830,8 +2113,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy_connect))-1 ) = PACK(InData%Fy_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy_connect) + DO i1 = LBOUND(InData%Fy_connect,1), UBOUND(InData%Fy_connect,1) + DbKiBuf(Db_Xferred) = InData%Fy_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1843,8 +2128,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz_connect))-1 ) = PACK(InData%Fz_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz_connect) + DO i1 = LBOUND(InData%Fz_connect,1), UBOUND(InData%Fz_connect,1) + DbKiBuf(Db_Xferred) = InData%Fz_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fx_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1856,8 +2143,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx_anchor))-1 ) = PACK(InData%Fx_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx_anchor) + DO i1 = LBOUND(InData%Fx_anchor,1), UBOUND(InData%Fx_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fx_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1869,8 +2158,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy_anchor))-1 ) = PACK(InData%Fy_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy_anchor) + DO i1 = LBOUND(InData%Fy_anchor,1), UBOUND(InData%Fy_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fy_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1882,8 +2173,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz_anchor))-1 ) = PACK(InData%Fz_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz_anchor) + DO i1 = LBOUND(InData%Fz_anchor,1), UBOUND(InData%Fz_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fz_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_PackOtherState @@ -1900,12 +2193,6 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1936,15 +2223,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%H)>0) OutData%H = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%H))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%H) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) + OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -1962,15 +2244,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ha not allocated Int_Xferred = Int_Xferred + 1 @@ -1988,15 +2265,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Ha)>0) OutData%Ha = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ha))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Ha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) + OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Va not allocated Int_Xferred = Int_Xferred + 1 @@ -2014,15 +2286,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Va)>0) OutData%Va = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Va))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Va) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) + OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated Int_Xferred = Int_Xferred + 1 @@ -2040,15 +2307,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -2066,15 +2328,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -2092,15 +2349,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xa not allocated Int_Xferred = Int_Xferred + 1 @@ -2118,15 +2370,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xa)>0) OutData%xa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%xa))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%xa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) + OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ya not allocated Int_Xferred = Int_Xferred + 1 @@ -2144,15 +2391,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ya)>0) OutData%ya = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ya))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%ya) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) + OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! za not allocated Int_Xferred = Int_Xferred + 1 @@ -2170,15 +2412,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%za)>0) OutData%za = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%za))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%za) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) + OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2196,15 +2433,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx_connect)>0) OutData%Fx_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx_connect,1), UBOUND(OutData%Fx_connect,1) + OutData%Fx_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2222,15 +2454,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy_connect)>0) OutData%Fy_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy_connect,1), UBOUND(OutData%Fy_connect,1) + OutData%Fy_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2248,15 +2475,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz_connect)>0) OutData%Fz_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz_connect,1), UBOUND(OutData%Fz_connect,1) + OutData%Fz_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2274,15 +2496,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx_anchor)>0) OutData%Fx_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx_anchor,1), UBOUND(OutData%Fx_anchor,1) + OutData%Fx_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2300,15 +2517,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy_anchor)>0) OutData%Fy_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy_anchor,1), UBOUND(OutData%Fy_anchor,1) + OutData%Fy_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2326,138 +2538,382 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz_anchor)>0) OutData%Fz_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz_anchor,1), UBOUND(OutData%Fz_anchor,1) + OutData%Fz_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_UnPackOtherState - SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ! -- H OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN - NULLIFY( OtherStateData%H ) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN + NULLIFY( OtherStateData%H ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) + END IF + END IF + + ! -- V OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN + NULLIFY( OtherStateData%V ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) + END IF + END IF + + ! -- Ha OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN + NULLIFY( OtherStateData%Ha ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) + END IF + END IF + + ! -- Va OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN + NULLIFY( OtherStateData%Va ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) + END IF + END IF + + ! -- x OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN + NULLIFY( OtherStateData%x ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) + END IF + END IF + + ! -- y OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN + NULLIFY( OtherStateData%y ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) + END IF + END IF + + ! -- z OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN + NULLIFY( OtherStateData%z ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) + END IF + END IF + + ! -- xa OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN + NULLIFY( OtherStateData%xa ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) + END IF + END IF + + ! -- ya OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN + NULLIFY( OtherStateData%ya ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) + END IF + END IF + + ! -- za OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN + NULLIFY( OtherStateData%za ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN + NULLIFY( OtherStateData%Fx_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN + NULLIFY( OtherStateData%Fy_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN + NULLIFY( OtherStateData%Fz_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN + NULLIFY( OtherStateData%Fx_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN + NULLIFY( OtherStateData%Fy_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN + NULLIFY( OtherStateData%Fz_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) + END IF + END IF + END SUBROUTINE MAP_C2Fary_CopyOtherState + + SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%H)) THEN + OtherStateData%c_obj%H_Len = 0 + OtherStateData%c_obj%H = C_NULL_PTR + ELSE + OtherStateData%c_obj%H_Len = SIZE(OtherStateData%H) + IF (OtherStateData%c_obj%H_Len > 0) & + OtherStateData%c_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) + END IF END IF ! -- V OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN - NULLIFY( OtherStateData%V ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%V)) THEN + OtherStateData%c_obj%V_Len = 0 + OtherStateData%c_obj%V = C_NULL_PTR + ELSE + OtherStateData%c_obj%V_Len = SIZE(OtherStateData%V) + IF (OtherStateData%c_obj%V_Len > 0) & + OtherStateData%c_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) + END IF END IF ! -- Ha OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN - NULLIFY( OtherStateData%Ha ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Ha)) THEN + OtherStateData%c_obj%Ha_Len = 0 + OtherStateData%c_obj%Ha = C_NULL_PTR + ELSE + OtherStateData%c_obj%Ha_Len = SIZE(OtherStateData%Ha) + IF (OtherStateData%c_obj%Ha_Len > 0) & + OtherStateData%c_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) + END IF END IF ! -- Va OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN - NULLIFY( OtherStateData%Va ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Va)) THEN + OtherStateData%c_obj%Va_Len = 0 + OtherStateData%c_obj%Va = C_NULL_PTR + ELSE + OtherStateData%c_obj%Va_Len = SIZE(OtherStateData%Va) + IF (OtherStateData%c_obj%Va_Len > 0) & + OtherStateData%c_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) + END IF END IF ! -- x OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN - NULLIFY( OtherStateData%x ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%x)) THEN + OtherStateData%c_obj%x_Len = 0 + OtherStateData%c_obj%x = C_NULL_PTR + ELSE + OtherStateData%c_obj%x_Len = SIZE(OtherStateData%x) + IF (OtherStateData%c_obj%x_Len > 0) & + OtherStateData%c_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) + END IF END IF ! -- y OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN - NULLIFY( OtherStateData%y ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%y)) THEN + OtherStateData%c_obj%y_Len = 0 + OtherStateData%c_obj%y = C_NULL_PTR + ELSE + OtherStateData%c_obj%y_Len = SIZE(OtherStateData%y) + IF (OtherStateData%c_obj%y_Len > 0) & + OtherStateData%c_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) + END IF END IF ! -- z OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN - NULLIFY( OtherStateData%z ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%z)) THEN + OtherStateData%c_obj%z_Len = 0 + OtherStateData%c_obj%z = C_NULL_PTR + ELSE + OtherStateData%c_obj%z_Len = SIZE(OtherStateData%z) + IF (OtherStateData%c_obj%z_Len > 0) & + OtherStateData%c_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) + END IF END IF ! -- xa OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN - NULLIFY( OtherStateData%xa ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%xa)) THEN + OtherStateData%c_obj%xa_Len = 0 + OtherStateData%c_obj%xa = C_NULL_PTR + ELSE + OtherStateData%c_obj%xa_Len = SIZE(OtherStateData%xa) + IF (OtherStateData%c_obj%xa_Len > 0) & + OtherStateData%c_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) + END IF END IF ! -- ya OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN - NULLIFY( OtherStateData%ya ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%ya)) THEN + OtherStateData%c_obj%ya_Len = 0 + OtherStateData%c_obj%ya = C_NULL_PTR + ELSE + OtherStateData%c_obj%ya_Len = SIZE(OtherStateData%ya) + IF (OtherStateData%c_obj%ya_Len > 0) & + OtherStateData%c_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) + END IF END IF ! -- za OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN - NULLIFY( OtherStateData%za ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%za)) THEN + OtherStateData%c_obj%za_Len = 0 + OtherStateData%c_obj%za = C_NULL_PTR + ELSE + OtherStateData%c_obj%za_Len = SIZE(OtherStateData%za) + IF (OtherStateData%c_obj%za_Len > 0) & + OtherStateData%c_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) + END IF END IF ! -- Fx_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN - NULLIFY( OtherStateData%Fx_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN + OtherStateData%c_obj%Fx_connect_Len = 0 + OtherStateData%c_obj%Fx_connect = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) + IF (OtherStateData%c_obj%Fx_connect_Len > 0) & + OtherStateData%c_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) + END IF END IF ! -- Fy_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN - NULLIFY( OtherStateData%Fy_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN + OtherStateData%c_obj%Fy_connect_Len = 0 + OtherStateData%c_obj%Fy_connect = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) + IF (OtherStateData%c_obj%Fy_connect_Len > 0) & + OtherStateData%c_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) + END IF END IF ! -- Fz_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN - NULLIFY( OtherStateData%Fz_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN + OtherStateData%c_obj%Fz_connect_Len = 0 + OtherStateData%c_obj%Fz_connect = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) + IF (OtherStateData%c_obj%Fz_connect_Len > 0) & + OtherStateData%c_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) + END IF END IF ! -- Fx_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN - NULLIFY( OtherStateData%Fx_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN + OtherStateData%c_obj%Fx_anchor_Len = 0 + OtherStateData%c_obj%Fx_anchor = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) + IF (OtherStateData%c_obj%Fx_anchor_Len > 0) & + OtherStateData%c_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) + END IF END IF ! -- Fy_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN - NULLIFY( OtherStateData%Fy_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN + OtherStateData%c_obj%Fy_anchor_Len = 0 + OtherStateData%c_obj%Fy_anchor = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) + IF (OtherStateData%c_obj%Fy_anchor_Len > 0) & + OtherStateData%c_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) + END IF END IF ! -- Fz_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN - NULLIFY( OtherStateData%Fz_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN + OtherStateData%c_obj%Fz_anchor_Len = 0 + OtherStateData%c_obj%Fz_anchor = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) + IF (OtherStateData%c_obj%Fz_anchor_Len > 0) & + OtherStateData%c_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) + END IF END IF - END SUBROUTINE MAP_C2Fary_CopyOtherState + END SUBROUTINE MAP_F2C_CopyOtherState SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ConstraintStateType), INTENT(IN) :: SrcConstrStateData @@ -2691,8 +3147,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%H)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%H))-1 ) = PACK(InData%H,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%H) + DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) + DbKiBuf(Db_Xferred) = InData%H(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2704,8 +3162,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2717,8 +3177,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2730,8 +3192,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2743,8 +3207,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_PackConstrState @@ -2761,12 +3227,6 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2797,15 +3257,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%H)>0) OutData%H = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%H))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%H) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) + OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -2823,15 +3278,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated Int_Xferred = Int_Xferred + 1 @@ -2849,15 +3299,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -2875,15 +3320,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -2901,62 +3341,152 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_UnPackConstrState - SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- H ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN - NULLIFY( ConstrStateData%H ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN + NULLIFY( ConstrStateData%H ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) + END IF END IF ! -- V ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN - NULLIFY( ConstrStateData%V ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN + NULLIFY( ConstrStateData%V ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) + END IF END IF ! -- x ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN - NULLIFY( ConstrStateData%x ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN + NULLIFY( ConstrStateData%x ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) + END IF END IF ! -- y ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN - NULLIFY( ConstrStateData%y ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN + NULLIFY( ConstrStateData%y ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) + END IF END IF ! -- z ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN - NULLIFY( ConstrStateData%z ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN + NULLIFY( ConstrStateData%z ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyConstrState + SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%H)) THEN + ConstrStateData%c_obj%H_Len = 0 + ConstrStateData%c_obj%H = C_NULL_PTR + ELSE + ConstrStateData%c_obj%H_Len = SIZE(ConstrStateData%H) + IF (ConstrStateData%c_obj%H_Len > 0) & + ConstrStateData%c_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) + END IF + END IF + + ! -- V ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%V)) THEN + ConstrStateData%c_obj%V_Len = 0 + ConstrStateData%c_obj%V = C_NULL_PTR + ELSE + ConstrStateData%c_obj%V_Len = SIZE(ConstrStateData%V) + IF (ConstrStateData%c_obj%V_Len > 0) & + ConstrStateData%c_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) + END IF + END IF + + ! -- x ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%x)) THEN + ConstrStateData%c_obj%x_Len = 0 + ConstrStateData%c_obj%x = C_NULL_PTR + ELSE + ConstrStateData%c_obj%x_Len = SIZE(ConstrStateData%x) + IF (ConstrStateData%c_obj%x_Len > 0) & + ConstrStateData%c_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) + END IF + END IF + + ! -- y ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%y)) THEN + ConstrStateData%c_obj%y_Len = 0 + ConstrStateData%c_obj%y = C_NULL_PTR + ELSE + ConstrStateData%c_obj%y_Len = SIZE(ConstrStateData%y) + IF (ConstrStateData%c_obj%y_Len > 0) & + ConstrStateData%c_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) + END IF + END IF + + ! -- z ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%z)) THEN + ConstrStateData%c_obj%z_Len = 0 + ConstrStateData%c_obj%z = C_NULL_PTR + ELSE + ConstrStateData%c_obj%z_Len = SIZE(ConstrStateData%z) + IF (ConstrStateData%c_obj%z_Len > 0) & + ConstrStateData%c_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyConstrState + SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ParameterType), INTENT(IN) :: SrcParamData TYPE(MAP_ParameterType), INTENT(INOUT) :: DstParamData @@ -2982,6 +3512,11 @@ SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%C_obj%dt = SrcParamData%C_obj%dt DstParamData%InputLines = SrcParamData%InputLines DstParamData%InputLineType = SrcParamData%InputLineType + DstParamData%numOuts = SrcParamData%numOuts + DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts + CALL MAP_Fortran_Copylin_paramtype( SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyParam SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -2993,6 +3528,7 @@ SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" + CALL MAP_Fortran_Destroylin_paramtype( ParamData%LinParams, ErrStat, ErrMsg ) END SUBROUTINE MAP_DestroyParam SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3036,6 +3572,25 @@ SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_BufSz = Db_BufSz + 1 ! dt Int_BufSz = Int_BufSz + SIZE(InData%InputLines)*LEN(InData%InputLines) ! InputLines Int_BufSz = Int_BufSz + SIZE(InData%InputLineType)*LEN(InData%InputLineType) ! InputLineType + Int_BufSz = Int_BufSz + 1 ! numOuts + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! LinParams: size of buffers for each call to pack subtype + CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, .TRUE. ) ! LinParams + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LinParams + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LinParams + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LinParams + 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 @@ -3065,26 +3620,56 @@ SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%depth - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rho_sea - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%g + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%depth + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rho_sea + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 DO i1 = LBOUND(InData%InputLines,1), UBOUND(InData%InputLines,1) - DO I = 1, LEN(InData%InputLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%InputLines) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO DO i1 = LBOUND(InData%InputLineType,1), UBOUND(InData%InputLineType,1) - DO I = 1, LEN(InData%InputLineType) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%InputLineType) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%numOuts + Int_Xferred = Int_Xferred + 1 + CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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 MAP_PackParam SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3100,12 +3685,6 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3120,63 +3699,123 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%g = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%g = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%g = OutData%g - OutData%depth = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%depth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%depth = OutData%depth - OutData%rho_sea = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%rho_sea = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%rho_sea = OutData%rho_sea - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dt = OutData%dt i1_l = LBOUND(OutData%InputLines,1) i1_u = UBOUND(OutData%InputLines,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%InputLines,1), UBOUND(OutData%InputLines,1) - DO I = 1, LEN(OutData%InputLines) - OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%InputLines) + OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO i1_l = LBOUND(OutData%InputLineType,1) i1_u = UBOUND(OutData%InputLineType,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%InputLineType,1), UBOUND(OutData%InputLineType,1) - DO I = 1, LEN(OutData%InputLineType) - OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%InputLineType) + OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%numOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%C_obj%numOuts = OutData%numOuts + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_Fortran_Unpacklin_paramtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinParams, ErrStat2, ErrMsg2 ) ! LinParams + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackParam - SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ParamData%g = ParamData%C_obj%g ParamData%depth = ParamData%C_obj%depth ParamData%rho_sea = ParamData%C_obj%rho_sea ParamData%dt = ParamData%C_obj%dt + ParamData%numOuts = ParamData%C_obj%numOuts END SUBROUTINE MAP_C2Fary_CopyParam + SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%g = ParamData%g + ParamData%C_obj%depth = ParamData%depth + ParamData%C_obj%rho_sea = ParamData%rho_sea + ParamData%C_obj%dt = ParamData%dt + ParamData%C_obj%numOuts = ParamData%numOuts + END SUBROUTINE MAP_F2C_CopyParam + SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_InputType), INTENT(INOUT) :: SrcInputData TYPE(MAP_InputType), INTENT(INOUT) :: DstInputData @@ -3379,8 +4018,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3392,8 +4033,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3405,8 +4048,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairDisplacement CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3451,12 +4096,6 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3487,15 +4126,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -3513,15 +4147,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -3539,15 +4168,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3591,36 +4215,103 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInput - SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- x Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN - NULLIFY( InputData%x ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN + NULLIFY( InputData%x ) + ELSE + CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) + END IF END IF ! -- y Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN - NULLIFY( InputData%y ) - ELSE - CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN + NULLIFY( InputData%y ) + ELSE + CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) + END IF END IF ! -- z Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN - NULLIFY( InputData%z ) - ELSE - CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN + NULLIFY( InputData%z ) + ELSE + CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyInput + SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%x)) THEN + InputData%c_obj%x_Len = 0 + InputData%c_obj%x = C_NULL_PTR + ELSE + InputData%c_obj%x_Len = SIZE(InputData%x) + IF (InputData%c_obj%x_Len > 0) & + InputData%c_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) + END IF + END IF + + ! -- y Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%y)) THEN + InputData%c_obj%y_Len = 0 + InputData%c_obj%y = C_NULL_PTR + ELSE + InputData%c_obj%y_Len = SIZE(InputData%y) + IF (InputData%c_obj%y_Len > 0) & + InputData%c_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) + END IF + END IF + + ! -- z Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%z)) THEN + InputData%c_obj%z_Len = 0 + InputData%c_obj%z = C_NULL_PTR + ELSE + InputData%c_obj%z_Len = SIZE(InputData%z) + IF (InputData%c_obj%z_Len > 0) & + InputData%c_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyInput + SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(MAP_OutputType), INTENT(INOUT) :: DstOutputData @@ -3692,7 +4383,6 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput - DstOutputData%C_obj%WriteOutput = SrcOutputData%C_obj%WriteOutput ENDIF IF (ASSOCIATED(SrcOutputData%wrtOutput)) THEN i1_l = LBOUND(SrcOutputData%wrtOutput,1) @@ -3870,8 +4560,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx))-1 ) = PACK(InData%Fx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx) + DO i1 = LBOUND(InData%Fx,1), UBOUND(InData%Fx,1) + DbKiBuf(Db_Xferred) = InData%Fx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3883,8 +4575,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy))-1 ) = PACK(InData%Fy,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy) + DO i1 = LBOUND(InData%Fy,1), UBOUND(InData%Fy,1) + DbKiBuf(Db_Xferred) = InData%Fy(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3896,8 +4590,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz))-1 ) = PACK(InData%Fz,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz) + DO i1 = LBOUND(InData%Fz,1), UBOUND(InData%Fz,1) + DbKiBuf(Db_Xferred) = InData%Fz(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3909,8 +4605,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%wrtOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3922,8 +4620,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wrtOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wrtOutput)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%wrtOutput))-1 ) = PACK(InData%wrtOutput,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%wrtOutput) + DO i1 = LBOUND(InData%wrtOutput,1), UBOUND(InData%wrtOutput,1) + DbKiBuf(Db_Xferred) = InData%wrtOutput(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptFairleadLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3968,12 +4668,6 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4004,15 +4698,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx)>0) OutData%Fx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx,1), UBOUND(OutData%Fx,1) + OutData%Fx(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy not allocated Int_Xferred = Int_Xferred + 1 @@ -4030,15 +4719,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy)>0) OutData%Fy = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy,1), UBOUND(OutData%Fy,1) + OutData%Fy(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz not allocated Int_Xferred = Int_Xferred + 1 @@ -4056,15 +4740,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz)>0) OutData%Fz = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz,1), UBOUND(OutData%Fz,1) + OutData%Fz(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4079,15 +4758,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wrtOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4105,15 +4779,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wrtOutput)>0) OutData%wrtOutput = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%wrtOutput))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%wrtOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) + OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4157,43 +4826,124 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackOutput - SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- Fx Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN - NULLIFY( OutputData%Fx ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN + NULLIFY( OutputData%Fx ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) + END IF END IF ! -- Fy Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN - NULLIFY( OutputData%Fy ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN + NULLIFY( OutputData%Fy ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) + END IF END IF ! -- Fz Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN - NULLIFY( OutputData%Fz ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN + NULLIFY( OutputData%Fz ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) + END IF END IF ! -- wrtOutput Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN - NULLIFY( OutputData%wrtOutput ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN + NULLIFY( OutputData%wrtOutput ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyOutput + SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fx)) THEN + OutputData%c_obj%Fx_Len = 0 + OutputData%c_obj%Fx = C_NULL_PTR + ELSE + OutputData%c_obj%Fx_Len = SIZE(OutputData%Fx) + IF (OutputData%c_obj%Fx_Len > 0) & + OutputData%c_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) + END IF + END IF + + ! -- Fy Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fy)) THEN + OutputData%c_obj%Fy_Len = 0 + OutputData%c_obj%Fy = C_NULL_PTR + ELSE + OutputData%c_obj%Fy_Len = SIZE(OutputData%Fy) + IF (OutputData%c_obj%Fy_Len > 0) & + OutputData%c_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) + END IF + END IF + + ! -- Fz Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fz)) THEN + OutputData%c_obj%Fz_Len = 0 + OutputData%c_obj%Fz = C_NULL_PTR + ELSE + OutputData%c_obj%Fz_Len = SIZE(OutputData%Fz) + IF (OutputData%c_obj%Fz_Len > 0) & + OutputData%c_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) + END IF + END IF + + ! -- wrtOutput Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%wrtOutput)) THEN + OutputData%c_obj%wrtOutput_Len = 0 + OutputData%c_obj%wrtOutput = C_NULL_PTR + ELSE + OutputData%c_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) + IF (OutputData%c_obj%wrtOutput_Len > 0) & + OutputData%c_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyOutput + SUBROUTINE MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -4269,12 +5019,12 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4287,29 +5037,25 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - ALLOCATE(b1(SIZE(u_out%x,1))) - ALLOCATE(c1(SIZE(u_out%x,1))) - b1 = -(u1%x - u2%x)/t(2) - u_out%x = u1%x + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) + b = -(u1%x(i1) - u2%x(i1)) + u_out%x(i1) = u1%x(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - ALLOCATE(b1(SIZE(u_out%y,1))) - ALLOCATE(c1(SIZE(u_out%y,1))) - b1 = -(u1%y - u2%y)/t(2) - u_out%y = u1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) + b = -(u1%y(i1) - u2%y(i1)) + u_out%y(i1) = u1%y(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - ALLOCATE(b1(SIZE(u_out%z,1))) - ALLOCATE(c1(SIZE(u_out%z,1))) - b1 = -(u1%z - u2%z)/t(2) - u_out%z = u1%z + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) + b = -(u1%z(i1) - u2%z(i1)) + u_out%z(i1) = u1%z(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4342,13 +5088,14 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4367,32 +5114,28 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - ALLOCATE(b1(SIZE(u_out%x,1))) - ALLOCATE(c1(SIZE(u_out%x,1))) - b1 = (t(3)**2*(u1%x - u2%x) + t(2)**2*(-u1%x + u3%x))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%x + t(3)*u2%x - t(2)*u3%x ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%x = u1%x + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) + b = (t(3)**2*(u1%x(i1) - u2%x(i1)) + t(2)**2*(-u1%x(i1) + u3%x(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%x(i1) + t(3)*u2%x(i1) - t(2)*u3%x(i1) ) * scaleFactor + u_out%x(i1) = u1%x(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - ALLOCATE(b1(SIZE(u_out%y,1))) - ALLOCATE(c1(SIZE(u_out%y,1))) - b1 = (t(3)**2*(u1%y - u2%y) + t(2)**2*(-u1%y + u3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%y + t(3)*u2%y - t(2)*u3%y ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%y = u1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) + b = (t(3)**2*(u1%y(i1) - u2%y(i1)) + t(2)**2*(-u1%y(i1) + u3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%y(i1) + t(3)*u2%y(i1) - t(2)*u3%y(i1) ) * scaleFactor + u_out%y(i1) = u1%y(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - ALLOCATE(b1(SIZE(u_out%z,1))) - ALLOCATE(c1(SIZE(u_out%z,1))) - b1 = (t(3)**2*(u1%z - u2%z) + t(2)**2*(-u1%z + u3%z))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%z + t(3)*u2%z - t(2)*u3%z ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%z = u1%z + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) + b = (t(3)**2*(u1%z(i1) - u2%z(i1)) + t(2)**2*(-u1%z(i1) + u3%z(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%z(i1) + t(3)*u2%z(i1) - t(2)*u3%z(i1) ) * scaleFactor + u_out%z(i1) = u1%z(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4473,12 +5216,12 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4491,45 +5234,37 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - ALLOCATE(b1(SIZE(y_out%Fx,1))) - ALLOCATE(c1(SIZE(y_out%Fx,1))) - b1 = -(y1%Fx - y2%Fx)/t(2) - y_out%Fx = y1%Fx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) + b = -(y1%Fx(i1) - y2%Fx(i1)) + y_out%Fx(i1) = y1%Fx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - ALLOCATE(b1(SIZE(y_out%Fy,1))) - ALLOCATE(c1(SIZE(y_out%Fy,1))) - b1 = -(y1%Fy - y2%Fy)/t(2) - y_out%Fy = y1%Fy + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) + b = -(y1%Fy(i1) - y2%Fy(i1)) + y_out%Fy(i1) = y1%Fy(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - ALLOCATE(b1(SIZE(y_out%Fz,1))) - ALLOCATE(c1(SIZE(y_out%Fz,1))) - b1 = -(y1%Fz - y2%Fz)/t(2) - y_out%Fz = y1%Fz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) + b = -(y1%Fz(i1) - y2%Fz(i1)) + y_out%Fz(i1) = y1%Fz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - ALLOCATE(b1(SIZE(y_out%wrtOutput,1))) - ALLOCATE(c1(SIZE(y_out%wrtOutput,1))) - b1 = -(y1%wrtOutput - y2%wrtOutput)/t(2) - y_out%wrtOutput = y1%wrtOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) + b = -(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4562,13 +5297,14 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4587,50 +5323,42 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - ALLOCATE(b1(SIZE(y_out%Fx,1))) - ALLOCATE(c1(SIZE(y_out%Fx,1))) - b1 = (t(3)**2*(y1%Fx - y2%Fx) + t(2)**2*(-y1%Fx + y3%Fx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fx + t(3)*y2%Fx - t(2)*y3%Fx ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fx = y1%Fx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) + b = (t(3)**2*(y1%Fx(i1) - y2%Fx(i1)) + t(2)**2*(-y1%Fx(i1) + y3%Fx(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fx(i1) + t(3)*y2%Fx(i1) - t(2)*y3%Fx(i1) ) * scaleFactor + y_out%Fx(i1) = y1%Fx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - ALLOCATE(b1(SIZE(y_out%Fy,1))) - ALLOCATE(c1(SIZE(y_out%Fy,1))) - b1 = (t(3)**2*(y1%Fy - y2%Fy) + t(2)**2*(-y1%Fy + y3%Fy))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fy + t(3)*y2%Fy - t(2)*y3%Fy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fy = y1%Fy + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) + b = (t(3)**2*(y1%Fy(i1) - y2%Fy(i1)) + t(2)**2*(-y1%Fy(i1) + y3%Fy(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fy(i1) + t(3)*y2%Fy(i1) - t(2)*y3%Fy(i1) ) * scaleFactor + y_out%Fy(i1) = y1%Fy(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - ALLOCATE(b1(SIZE(y_out%Fz,1))) - ALLOCATE(c1(SIZE(y_out%Fz,1))) - b1 = (t(3)**2*(y1%Fz - y2%Fz) + t(2)**2*(-y1%Fz + y3%Fz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fz + t(3)*y2%Fz - t(2)*y3%Fz ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fz = y1%Fz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) + b = (t(3)**2*(y1%Fz(i1) - y2%Fz(i1)) + t(2)**2*(-y1%Fz(i1) + y3%Fz(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fz(i1) + t(3)*y2%Fz(i1) - t(2)*y3%Fz(i1) ) * scaleFactor + y_out%Fz(i1) = y1%Fz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - ALLOCATE(b1(SIZE(y_out%wrtOutput,1))) - ALLOCATE(c1(SIZE(y_out%wrtOutput,1))) - b1 = (t(3)**2*(y1%wrtOutput - y2%wrtOutput) + t(2)**2*(-y1%wrtOutput + y3%wrtOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%wrtOutput + t(3)*y2%wrtOutput - t(2)*y3%wrtOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wrtOutput = y1%wrtOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) + b = (t(3)**2*(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + t(2)**2*(-y1%wrtOutput(i1) + y3%wrtOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%wrtOutput(i1) + t(3)*y2%wrtOutput(i1) - t(2)*y3%wrtOutput(i1) ) * scaleFactor + y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) diff --git a/modules/map/src/MAP_Types.h b/modules/map/src/MAP_Types.h index b9ae693e26..737caea111 100644 --- a/modules/map/src/MAP_Types.h +++ b/modules/map/src/MAP_Types.h @@ -31,6 +31,7 @@ char node_input_str[255] ; char line_input_str[255] ; char option_input_str[255] ; + } MAP_InitInputType_t ; typedef struct MAP_InitOutputType { void * object ; @@ -40,6 +41,7 @@ char * writeOutputHdr ; int writeOutputHdr_Len ; char * writeOutputUnt ; int writeOutputUnt_Len ; + } MAP_InitOutputType_t ; typedef struct MAP_ContinuousStateType { void * object ; @@ -84,6 +86,8 @@ double dt ; + int numOuts ; + } MAP_ParameterType_t ; typedef struct MAP_InputType { void * object ; diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index 1c6904ad1b..4d4f43de4f 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -32,6 +32,8 @@ MODULE MAP PUBLIC :: MAP_Init PUBLIC :: MAP_UpdateStates PUBLIC :: MAP_CalcOutput + PUBLIC :: MAP_JacobianPInput + PUBLIC :: MAP_GetOP PUBLIC :: MAP_End PUBLIC :: MAP_Restart @@ -653,6 +655,8 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt ! End mesh initialization ! -------+ !============================================================================== + + ! Program version N = LEN(InitOut%version) DO i=1,N @@ -676,11 +680,20 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt END DO InitOut%Ver = ProgDesc('MAP++',TRIM(InitOut%version),TRIM(InitOut%compilingData)) - - IF ( ALLOCATED(InitOut%WriteOutputHdr) ) THEN - ALLOCATE( y%WriteOutput(SIZE(InitOut%WriteOutputHdr)), STAT=n) - IF (N/=0) CALL SetErrStat(ErrID_Fatal, 'Failed to allocate y%WriteOutput',ErrStat, ErrMsg, RoutineName) - END IF + p%numOuts = 0 + if ( allocated(InitOut%WriteOutputHdr) ) THEN + p%numOuts = size(InitOut%WriteOutputHdr) + allocate( y%WriteOutput(p%numOuts), STAT=N) + if (N/=0) call SetErrStat(ErrID_Fatal, 'Failed to allocate y%WriteOutput',ErrStat, ErrMsg, RoutineName) + end if + + !............................................................................................ + ! Initialize Jacobian information: + !............................................................................................ + if (InitInp%LinInitInp%Linearize) then + call map_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if END SUBROUTINE MAP_Init ! -------+ !========================================================================================================== @@ -1065,6 +1078,419 @@ SUBROUTINE map_set_input_file_contents(InitInp, p) END DO END SUBROUTINE map_set_input_file_contents +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) +!! Do not change this without making sure subroutine map::map_init_jacobian is consistant with this routine! +SUBROUTINE map_Perturb_u( p, n, perturb_sign, u, du ) + + TYPE(map_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(map_InputType) , INTENT(INOUT) :: u !< perturbed map inputs + REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed + + + ! local variables + integer :: fieldIndx + integer :: node + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + fieldIndx = p%LinParams%Jac_u_indx(n,2) + node = p%LinParams%Jac_u_indx(n,3) + du = p%LinParams%du + u%PtFairDisplacement%TranslationDisp (fieldIndx,node) = u%PtFairDisplacement%TranslationDisp (fieldIndx,node) + du * perturb_sign + +END SUBROUTINE map_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 map::map_init_jacobian is consistant with this routine! +SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) + + TYPE(map_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(map_OutputType) , INTENT(IN ) :: y_p !< map outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) + TYPE(map_OutputType) , INTENT(IN ) :: y_m !< map outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) + REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta 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 x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ + + ! local variables: + + integer(IntKi) :: indx_first ! index indicating next value of dY to be filled + logical :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + integer(IntKi) :: k + + indx_first = 1 + if ( y_p%ptFairleadLoad%Committed ) then + call PackLoadMesh_dY(y_p%ptFairleadLoad, y_m%ptFairleadLoad, dY, indx_first) + end if + + do k=1,p%numOuts + dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) + end do + + + + dY = dY / (2.0_R8Ki*delta) + +END SUBROUTINE Compute_dY +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. +!! Do not change the order of this packing without changing corresponding linearization routines ! +SUBROUTINE MAP_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) + + TYPE(map_ParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(map_InputType) , INTENT(IN ) :: u !< inputs + TYPE(map_OutputType) , INTENT(IN ) :: y !< outputs + TYPE(map_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Init_Jacobian' + + ! local variables: + INTEGER(IntKi) :: i, j, k, index, index_next, index_last, nu, i_meshField, m, meshFieldCount + REAL(R8Ki) :: perturb_t, perturb + REAL(R8Ki) :: ScaleLength + LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + + ErrStat = ErrID_None + ErrMsg = "" + + !...................................... + ! init linearization outputs: + !...................................... + + ! determine how many outputs there are in the Jacobians + p%LinParams%Jac_ny = 0 + if ( y%ptFairleadLoad%Committed ) then + p%LinParams%Jac_ny = y%ptFairleadLoad%NNodes * 3 ! 3 Forces, no Moments, at each node on the fairlead loads mesh + end if + + p%LinParams%Jac_ny = p%LinParams%Jac_ny + p%numOuts ! WriteOutput values + + !................. + ! set linearization output names: + !................. + call AllocAry(InitOut%LinInitOut%LinNames_y, p%LinParams%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + index_next = 1 + if ( y%ptFairleadLoad%Committed ) then + index_last = index_next + call PackLoadMesh_Names(y%ptFairleadLoad, 'FairleadLoads', InitOut%LinInitOut%LinNames_y, index_next) + end if + + index_last = index_next + do i=1,p%numOuts + InitOut%LinInitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + end do + + + !...................................... + ! init linearization inputs: + !...................................... + + + ! determine how many inputs there are in the Jacobians + nu = 0; + if ( u%PtFairDisplacement%Committed ) then + nu = nu + u%PtFairDisplacement%NNodes * 3 ! 3 TranslationDisp at each node + end if + + ! note: all other inputs are ignored + + !.................... + ! fill matrix to store index to help us figure out what the ith value of the u vector really means + ! (see hydrodyn::map_perturb_u ... these MUST match ) + ! column 1 indicates module's mesh and field + ! column 2 indicates the first index of the acceleration/load field + ! column 3 is the node + !.................... + + !............... + ! MAP input mappings stored in p%Jac_u_indx: + !............... + call AllocAry(p%LinParams%Jac_u_indx, nu, 3, 'p%LinParams%Jac_u_indx', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + index = 1 + meshFieldCount = 0 + if ( u%PtFairDisplacement%Committed ) then + !Module/Mesh/Field: u%PtFairDisplacement%TranslationDisp = 1; + i_meshField = 1 + do i=1,u%PtFairDisplacement%NNodes + do j=1,3 + p%LinParams%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PtFairDisplacement%{TranslationDisp} = m + p%LinParams%Jac_u_indx(index,2) = j !index: j + p%LinParams%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + meshFieldCount = meshFieldCount + 1 + end if + + !................ + ! input perturbations, du: + !................ + + p%LinParams%du = 0.2_R8Ki*D2R * max(p%depth,1.0_R8Ki) ! translation input scaling ! u%PtFairDisplacement%TranslationDisp + + !................ + ! names of the columns, InitOut%LinNames_u: + !................ + call AllocAry(InitOut%LinInitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry(InitOut%LinInitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + InitOut%LinInitOut%IsLoad_u(:) = .false. ! MAP's inputs are NOT loads + + index = 1 + if ( u%PtFairDisplacement%Committed ) then + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + call PackMotionMesh_Names(u%PtFairDisplacement, 'PtFairDisplacement', InitOut%LinInitOut%LinNames_u, index, FieldMask=FieldMask) + end if + +END SUBROUTINE MAP_Init_Jacobian + +SUBROUTINE MAP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, dYdu ) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(map_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(map_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at operating point + TYPE(map_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states at operating point + TYPE(map_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states at operating point + TYPE(map_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at operating point + TYPE(map_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. + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the inputs (u) [intent in to avoid deallocation] + + + ! local variables + INTEGER(KIND=C_INT) :: status_from_MAP + CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP + REAL(KIND=C_FLOAT) :: time + INTEGER(KIND=C_INT) :: interval + + TYPE(map_OutputType) :: y_p + TYPE(map_OutputType) :: y_m + TYPE(map_ConstraintStateType) :: z_perturb + TYPE(map_InputType) :: u_perturb + REAL(R8Ki) :: delta ! delta change in input or state + INTEGER(IntKi) :: i, j, NN, offsetI, offsetJ + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'map_JacobianPInput' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + time = t + interval = t / p%dt + + if ( present( dYdu ) ) then + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + + ! allocate dYdu if necessary + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%LinParams%Jac_ny, size(p%LinParams%Jac_u_indx,1), 'dYdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + + + do i=1,size(p%LinParams%Jac_u_indx,1) + + ! get u_op + delta u + call map_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call map_Perturb_u( p, i, 1, u_perturb, delta ) + + call MAP_CopyConstrState( z, z_perturb, MESH_NEWCOPY, 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 + + DO j = 1,u_perturb%PtFairDisplacement%NNodes + u_perturb%X(j) = u_perturb%PtFairDisplacement%Position(1,j) + u_perturb%PtFairDisplacement%TranslationDisp(1,j) + u_perturb%Y(j) = u_perturb%PtFairDisplacement%Position(2,j) + u_perturb%PtFairDisplacement%TranslationDisp(2,j) + u_perturb%Z(j) = u_perturb%PtFairDisplacement%Position(3,j) + u_perturb%PtFairDisplacement%TranslationDisp(3,j) + END DO + + ! compute constraint state for u_op + delta u + call MSQS_UpdateStates( time , & + interval , & + u_perturb%C_obj , & + p%C_obj , & + x%C_obj , & + xd%C_obj , & + z_perturb%C_obj , & + OtherState%C_obj , & + status_from_MAP , & + message_from_MAP ) + + call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg, RoutineName) + + + + ! compute y at u_op + delta u + call map_CalcOutput( t, u_perturb, p, x, xd, z_perturb, OtherState, y, 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 + + ! We need to do this copy inside the loop because MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. + call map_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get u_op - delta u + call map_CopyInput( u, u_perturb, MESH_NEWCOPY, 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 + + ! Minus perturbation + call map_Perturb_u( p, i, -1, u_perturb, delta ) + + call MAP_CopyConstrState( z, z_perturb, MESH_NEWCOPY, 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 + + + DO j = 1,u_perturb%PtFairDisplacement%NNodes + u_perturb%X(j) = u_perturb%PtFairDisplacement%Position(1,j) + u_perturb%PtFairDisplacement%TranslationDisp(1,j) + u_perturb%Y(j) = u_perturb%PtFairDisplacement%Position(2,j) + u_perturb%PtFairDisplacement%TranslationDisp(2,j) + u_perturb%Z(j) = u_perturb%PtFairDisplacement%Position(3,j) + u_perturb%PtFairDisplacement%TranslationDisp(3,j) + END DO + + ! compute constraint state for u_op + delta u + call MSQS_UpdateStates( time , & + interval , & + u_perturb%C_obj , & + p%C_obj , & + x%C_obj , & + xd%C_obj , & + z_perturb%C_obj , & + OtherState%C_obj , & + status_from_MAP , & + message_from_MAP ) + + call MAP_ERROR_CHECKER(message_from_MAP,status_from_MAP,ErrMsg2,ErrStat2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg, RoutineName) + + ! compute y at u_op - delta u + call map_CalcOutput( t, u_perturb, p, x, xd, z_perturb, OtherState, y, 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 + + ! We need to do this copy inside the loop because MAP++ (in the c-code) requires that the output data structure be y, which was used when MAP++ was initialized. + call map_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get central difference: note: assumes delta is equivalent for both perturb_u calls. + call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) + + end do + end if + call cleanup() + +contains + subroutine cleanup() + call map_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call map_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call map_DestroyConstrState( z_perturb, ErrStat2, ErrMsg2 ) + call map_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) + + end subroutine cleanup +END SUBROUTINE MAP_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to pack the data structures representing the operating points into arrays for linearization. +SUBROUTINE MAP_GetOP( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y_op) + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(map_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(map_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(map_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(map_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(map_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(map_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(map_OutputType), INTENT(IN ) :: y !< Output at operating point + 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 + + + + INTEGER(IntKi) :: i, k, index, nu + INTEGER(IntKi) :: ny + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'map_GetOP' + TYPE(map_ContinuousStateType) :: dx !< derivative of continuous states at operating point + LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + + !LIN-TODO: Need to review and implement this routine per plan. Do not understand how to implement at the moment, GJH. + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + !.................................. + IF ( PRESENT( u_op ) ) THEN + + if (.not. allocated(u_op)) then + + nu = size(p%LinParams%Jac_u_indx,1) + + call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + + end if + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + + index = 1 + if ( u%PtFairDisplacement%Committed ) then + call PackMotionMesh(u%PtFairDisplacement, u_op, index, FieldMask=Mask) + end if + + END IF + + !.................................. + if ( PRESENT( y_op ) ) then + + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + + index = 1 + if ( y%ptFairleadLoad%Committed ) then + call PackLoadMesh(y%ptFairleadLoad, y_op, index) + end if + + index = index - 1 + do i=1,p%numOuts + y_op(i+index) = y%WriteOutput(i) + end do + + end if + +END SUBROUTINE MAP_GetOP + !========================================================================================================== ! ========== MAP_ERROR ====== <-------------------------------------------------------------------+ diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index b0d48ef873..b453ab6a4e 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -58,7 +58,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(ReKi) :: t ! instantaneous time, to be used during IC generation + REAL(DbKi) :: t ! instantaneous time, to be used during IC generation INTEGER(IntKi) :: I ! index INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index @@ -391,7 +391,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er END DO END DO - t = 0.0_ReKi ! start time at zero + t = 0.0_DbKi ! start time at zero ! because TimeStep wants an array... call MD_CopyInput( u, uArray(1), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) @@ -466,7 +466,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) ! Set error status/message; IF ( ErrID /= ErrID_None ) THEN @@ -518,12 +518,12 @@ 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 - REAL(ReKi) :: t2 ! should work out a consistent data type for time... + REAL(DbKi) :: t2 ! copy of time passed to TimeStep nTime = size(u) ! the number of times of input data provided? - t2 = real(t, ReKi) + t2 = t ! >>> removing this section and putting it inside loop of TimeStep (to be done at every time step) <<< ! ! create space for arrays/meshes in u_interp @@ -604,7 +604,6 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) TYPE(MD_ContinuousStateType) :: dxdt ! time derivatives of continuous states (initialized in CalcContStateDeriv) INTEGER(IntKi) :: I ! counter INTEGER(IntKi) :: J ! counter - REAL(ReKi) :: t2 ! real version of t (double) INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None @@ -612,8 +611,6 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) ! below updated to make sure outputs are current (based on provided x and u) - similar to what's in UpdateStates - t2 = real(t, ReKi) - ! go through fairleads and apply motions from driver DO I = 1, p%NFairs DO J = 1,3 @@ -623,7 +620,7 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) END DO ! call CalcContStateDeriv in order to run model and calculate dynamics with provided x and u - CALL MD_CalcContStateDeriv( t2, u, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) + CALL MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) ! assign net force on fairlead Connects to the output mesh @@ -635,7 +632,7 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) ! calculate outputs (y%WriteOutput) for glue code and write any m outputs to MoorDyn output files - CALL MDIO_WriteOutputs(REAL(t,DbKi) , p, m, y, ErrStat2, ErrMsg2) + CALL MDIO_WriteOutputs(t, p, m, y, ErrStat2, ErrMsg2) CALL CheckError(ErrStat2, 'In MDIO_WriteOutputs: '//trim(ErrMsg2)) IF ( ErrStat >= AbortErrLev ) RETURN @@ -680,7 +677,7 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ! Tight coupling routine for computing derivatives of continuous states ! this is modelled off what used to be subroutine DoRHSmaster - REAL(ReKi), INTENT(IN ) :: t ! Current simulation time in seconds + REAL(DbKi), INTENT(IN ) :: t ! Current simulation time in seconds TYPE(MD_InputType), INTENT(IN ) :: u ! Inputs at t TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters TYPE(MD_ContinuousStateType), INTENT(IN ) :: x ! Continuous states at t @@ -774,7 +771,7 @@ SUBROUTINE DoLineRHS (X, Xd, t, Line, LineProp, FairFtot, FairMtot, AnchFtot, An Real(ReKi), INTENT( IN ) :: X(:) ! state vector, provided Real(ReKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT - Real(ReKi), INTENT (IN) :: t ! instantaneous time + 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(ReKi), INTENT(INOUT) :: FairFtot(:) ! total force on Connect top of line is attached to @@ -1025,7 +1022,7 @@ SUBROUTINE DoConnectRHS (X, Xd, t, Connect) Real(ReKi), INTENT( IN ) :: X(:) ! state vector for this connect, provided Real(ReKi), INTENT( OUT ) :: Xd(:) ! derivative of state vector for this connect, returned - Real(ReKi), INTENT (IN) :: t ! instantaneous time + Real(DbKi), INTENT (IN) :: t ! instantaneous time Type(MD_Connect), INTENT (INOUT) :: Connect ! Connect number @@ -1040,7 +1037,7 @@ SUBROUTINE DoConnectRHS (X, Xd, t, Connect) ! itself, which will be added below. - IF (EqualRealNos(t, 0.0_ReKi)) 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 + 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 @@ -1179,7 +1176,7 @@ END SUBROUTINE MD_End !======================================================================================================== SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg ) - REAL(ReKi) , INTENT(INOUT) :: t + REAL(DbKi) , INTENT(INOUT) :: t REAL(ReKi) , 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(:)? @@ -1196,7 +1193,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM TYPE(MD_ContinuousStateType) :: dxdt ! time derivatives of continuous states (initialized in CalcContStateDeriv) TYPE(MD_ContinuousStateType) :: x2 ! temporary copy of continuous states used in RK2 calculations INTEGER(IntKi) :: NdtM ! the number of time steps to make with the mooring model - Real(ReKi) :: dtM ! the actual time step size to use + Real(DbKi) :: dtM ! the actual time step size to use INTEGER(IntKi) :: Nx ! size of states vector INTEGER(IntKi) :: I ! counter INTEGER(IntKi) :: J ! counter @@ -1224,7 +1221,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM 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?) ! ------------------------------------------------------------------------------- @@ -1233,7 +1230,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, tDbKi , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) + CALL MD_Input_ExtrapInterp(u, utimes, 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 @@ -1242,7 +1239,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, tDbKi + 0.5_ReKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) + 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_CalcContStateDeriv( (t + 0.5_ReKi*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 diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index ad25b1ced3..aca3d57559 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -908,7 +908,7 @@ 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 :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line CHARACTER(200) :: Frmt ! a string to hold a format statement INTEGER :: ErrStat2 diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 6877ab0baa..35e63e8cfd 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -26,7 +26,7 @@ typedef ^ ^ ReKi DTIC - - 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(10) 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" # ====================================== Internal data types ======================================================================== @@ -98,8 +98,8 @@ typedef ^ ^ ReKi LineWrOutput {:} # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) -typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" -typedef ^ ^ CHARACTER(10) Units - - - "units string" +typedef ^ MD_OutParmType CHARACTER(ChanLen) Name - - - "name of output channel" +typedef ^ ^ CHARACTER(ChanLen) 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" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 1bcad55447..d9e507a624 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -46,7 +46,7 @@ MODULE MoorDyn_Types 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(10) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] END TYPE MD_InitInputType ! ======================= ! ========= MD_LineProp ======= @@ -122,8 +122,8 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(10) :: Name !< name of output channel [-] - CHARACTER(10) :: Units !< units string [-] + CHARACTER(ChanLen) :: Name !< name of output channel [-] + CHARACTER(ChanLen) :: 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 [-] @@ -336,32 +336,34 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDepth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmInit))-1 ) = PACK(InData%PtfmInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmInit) - 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:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMaxIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%threshIC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDepth + Re_Xferred = Re_Xferred + 1 + 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 IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -372,12 +374,12 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE MD_PackInitInput @@ -394,12 +396,6 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -416,41 +412,36 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%PtfmInit,1) i1_u = UBOUND(OutData%PtfmInit,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmInit) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - 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 + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%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 @@ -464,19 +455,12 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE MD_UnPackInitInput @@ -589,28 +573,28 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%d - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%w - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Can - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cdn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cdt - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%name) + IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%d + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%w + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Can + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cdn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cdt + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackLineProp SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -626,12 +610,6 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLineProp' @@ -645,28 +623,28 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%w = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Can = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cdn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cdt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_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 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%w = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Can = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cdn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cdt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackLineProp SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) @@ -836,14 +814,14 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = 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:Int_Xferred+(1)-1 ) = InData%TypeNum - Int_Xferred = 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 IF ( .NOT. ALLOCATED(InData%AttachedFairs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -854,8 +832,10 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedFairs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AttachedFairs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AttachedFairs))-1 ) = PACK(InData%AttachedFairs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AttachedFairs) + 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 @@ -867,39 +847,55 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedAnchs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AttachedAnchs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AttachedAnchs))-1 ) = PACK(InData%AttachedAnchs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AttachedAnchs) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conCdA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ftot))-1 ) = PACK(InData%Ftot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ftot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mtot))-1 ) = PACK(InData%Mtot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mtot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%S))-1 ) = PACK(InData%S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r))-1 ) = PACK(InData%r,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rd))-1 ) = PACK(InData%rd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rd) + 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 + ReKiBuf(Re_Xferred) = InData%conX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conCdA + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%Ftot,1), UBOUND(InData%Ftot,1) + ReKiBuf(Re_Xferred) = InData%Ftot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Mtot,2), UBOUND(InData%Mtot,2) + DO i1 = LBOUND(InData%Mtot,1), UBOUND(InData%Mtot,1) + ReKiBuf(Re_Xferred) = InData%Mtot(i1,i2) + Re_Xferred = Re_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) + ReKiBuf(Re_Xferred) = InData%S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + ReKiBuf(Re_Xferred) = InData%r(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + ReKiBuf(Re_Xferred) = InData%rd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE MD_PackConnect SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -915,12 +911,6 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -936,14 +926,14 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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 + 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 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedFairs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -957,15 +947,10 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AttachedFairs)>0) OutData%AttachedFairs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AttachedFairs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AttachedFairs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AttachedFairs,1), UBOUND(OutData%AttachedFairs,1) + OutData%AttachedFairs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedAnchs not allocated Int_Xferred = Int_Xferred + 1 @@ -980,95 +965,69 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AttachedAnchs)>0) OutData%AttachedAnchs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AttachedAnchs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AttachedAnchs) - DEALLOCATE(mask1) - END IF - OutData%conX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conCdA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%AttachedAnchs,1), UBOUND(OutData%AttachedAnchs,1) + OutData%AttachedAnchs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%conX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conCdA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%Ftot,1) i1_u = UBOUND(OutData%Ftot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Ftot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ftot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ftot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Ftot,1), UBOUND(OutData%Ftot,1) + OutData%Ftot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_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) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Mtot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mtot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mtot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Mtot,2), UBOUND(OutData%Mtot,2) + DO i1 = LBOUND(OutData%Mtot,1), UBOUND(OutData%Mtot,1) + OutData%Mtot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_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) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%S))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%S) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) + DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) + OutData%S(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%r,1) i1_u = UBOUND(OutData%r,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%rd,1) i1_u = UBOUND(OutData%rd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE MD_UnPackConnect SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) @@ -1595,26 +1554,28 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = 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:Int_Xferred+(SIZE(InData%OutFlagList))-1 ) = PACK(InData%OutFlagList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutFlagList) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FairConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AnchConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UnstrLen - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BA - Re_Xferred = Re_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 + 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%FairConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AnchConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropsIdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UnstrLen + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BA + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%r) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1628,8 +1589,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%r)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r))-1 ) = PACK(InData%r,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r) + DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + ReKiBuf(Re_Xferred) = InData%r(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1644,8 +1609,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rd))-1 ) = PACK(InData%rd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rd) + DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + ReKiBuf(Re_Xferred) = InData%rd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1660,8 +1629,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q) + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + ReKiBuf(Re_Xferred) = InData%q(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%l) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1673,8 +1646,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%l)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%l))-1 ) = PACK(InData%l,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%l) + DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) + ReKiBuf(Re_Xferred) = InData%l(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%lstr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1686,8 +1661,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lstr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%lstr))-1 ) = PACK(InData%lstr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%lstr) + DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) + ReKiBuf(Re_Xferred) = InData%lstr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1699,8 +1676,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lstrd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%lstrd))-1 ) = PACK(InData%lstrd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%lstrd) + DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) + ReKiBuf(Re_Xferred) = InData%lstrd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1712,8 +1691,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1728,8 +1709,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%T))-1 ) = PACK(InData%T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%T) + DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) + DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) + ReKiBuf(Re_Xferred) = InData%T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Td) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1744,8 +1729,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Td)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Td))-1 ) = PACK(InData%Td,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Td) + DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) + DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) + ReKiBuf(Re_Xferred) = InData%Td(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%W) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1760,8 +1749,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W))-1 ) = PACK(InData%W,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W) + DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) + DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) + ReKiBuf(Re_Xferred) = InData%W(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1776,8 +1769,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dp))-1 ) = PACK(InData%Dp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dp) + DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) + DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) + ReKiBuf(Re_Xferred) = InData%Dp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1792,8 +1789,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dq))-1 ) = PACK(InData%Dq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dq) + DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) + DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) + ReKiBuf(Re_Xferred) = InData%Dq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ap) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1808,8 +1809,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ap)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ap))-1 ) = PACK(InData%Ap,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ap) + DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) + DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) + ReKiBuf(Re_Xferred) = InData%Ap(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Aq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1824,8 +1829,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Aq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Aq))-1 ) = PACK(InData%Aq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Aq) + DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) + DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) + ReKiBuf(Re_Xferred) = InData%Aq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1840,8 +1849,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1856,8 +1869,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F))-1 ) = PACK(InData%F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F) + DO i2 = LBOUND(InData%F,2), UBOUND(InData%F,2) + DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) + ReKiBuf(Re_Xferred) = InData%F(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1875,8 +1892,14 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%S))-1 ) = PACK(InData%S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%S) + 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) + ReKiBuf(Re_Xferred) = InData%S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1894,11 +1917,17 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + 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) + ReKiBuf(Re_Xferred) = InData%M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 + 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 @@ -1909,8 +1938,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineWrOutput))-1 ) = PACK(InData%LineWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineWrOutput) + DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) + ReKiBuf(Re_Xferred) = InData%LineWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackLine @@ -1927,12 +1958,6 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1949,35 +1974,30 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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%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 i1_l = LBOUND(OutData%OutFlagList,1) i1_u = UBOUND(OutData%OutFlagList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutFlagList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutFlagList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutFlagList) - DEALLOCATE(mask1) - OutData%FairConnect = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 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%FairConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AnchConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropsIdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnstrLen = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1994,15 +2014,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%r)>0) OutData%r = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated Int_Xferred = Int_Xferred + 1 @@ -2020,15 +2037,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rd)>0) OutData%rd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rd))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rd) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated Int_Xferred = Int_Xferred + 1 @@ -2046,15 +2060,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q)>0) OutData%q = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated Int_Xferred = Int_Xferred + 1 @@ -2069,15 +2080,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%l)>0) OutData%l = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%l))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%l) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) + OutData%l(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated Int_Xferred = Int_Xferred + 1 @@ -2092,15 +2098,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lstr)>0) OutData%lstr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%lstr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%lstr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) + OutData%lstr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated Int_Xferred = Int_Xferred + 1 @@ -2115,15 +2116,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lstrd)>0) OutData%lstrd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%lstrd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%lstrd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) + OutData%lstrd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -2138,15 +2134,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated Int_Xferred = Int_Xferred + 1 @@ -2164,15 +2155,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%T)>0) OutData%T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%T))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) + DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) + OutData%T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated Int_Xferred = Int_Xferred + 1 @@ -2190,15 +2178,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Td)>0) OutData%Td = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Td))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Td) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) + DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) + OutData%Td(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated Int_Xferred = Int_Xferred + 1 @@ -2216,15 +2201,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%W)>0) OutData%W = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) + DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) + OutData%W(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated Int_Xferred = Int_Xferred + 1 @@ -2242,15 +2224,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dp)>0) OutData%Dp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) + DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) + OutData%Dp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated Int_Xferred = Int_Xferred + 1 @@ -2268,15 +2247,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dq)>0) OutData%Dq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dq) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) + DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) + OutData%Dq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated Int_Xferred = Int_Xferred + 1 @@ -2294,15 +2270,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Ap)>0) OutData%Ap = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ap))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ap) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) + DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) + OutData%Ap(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated Int_Xferred = Int_Xferred + 1 @@ -2320,15 +2293,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Aq)>0) OutData%Aq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Aq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Aq) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) + DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) + OutData%Aq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -2346,15 +2316,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated Int_Xferred = Int_Xferred + 1 @@ -2372,15 +2339,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F)>0) OutData%F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F,2), UBOUND(OutData%F,2) + DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) + OutData%F(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated Int_Xferred = Int_Xferred + 1 @@ -2401,15 +2365,14 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%S)>0) OutData%S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%S))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%S) - DEALLOCATE(mask3) + 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) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -2430,18 +2393,17 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask3) + 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) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%LineUnOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + 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 @@ -2455,15 +2417,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineWrOutput)>0) OutData%LineWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) + OutData%LineWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackLine @@ -2568,22 +2525,22 @@ SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM 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:Int_Xferred+(1)-1 ) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ObjID - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%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 ) @@ -2599,12 +2556,6 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutParmType' @@ -2618,22 +2569,22 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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 + 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 ) @@ -2798,12 +2749,12 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2815,12 +2766,12 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -2865,12 +2816,6 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2898,19 +2843,12 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2925,19 +2863,12 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3101,8 +3032,10 @@ SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%states)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%states))-1 ) = PACK(InData%states,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%states) + DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) + ReKiBuf(Re_Xferred) = InData%states(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackContState @@ -3119,12 +3052,6 @@ SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3152,15 +3079,10 @@ SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%states)>0) OutData%states = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%states))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%states) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) + OutData%states(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackContState @@ -3255,8 +3177,8 @@ SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_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 ) @@ -3272,12 +3194,6 @@ SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackDiscState' @@ -3291,8 +3207,8 @@ SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_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 ) @@ -3386,8 +3302,8 @@ SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_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 ) @@ -3403,12 +3319,6 @@ SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConstrState' @@ -3422,8 +3332,8 @@ SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_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 ) @@ -3517,8 +3427,8 @@ SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_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 ) @@ -3534,12 +3444,6 @@ SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOtherState' @@ -3553,8 +3457,8 @@ SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_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 ) @@ -3996,8 +3900,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FairIdList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FairIdList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FairIdList))-1 ) = PACK(InData%FairIdList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FairIdList) + DO i1 = LBOUND(InData%FairIdList,1), UBOUND(InData%FairIdList,1) + IntKiBuf(Int_Xferred) = InData%FairIdList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ConnIdList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4009,8 +3915,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnIdList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ConnIdList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnIdList))-1 ) = PACK(InData%ConnIdList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnIdList) + DO i1 = LBOUND(InData%ConnIdList,1), UBOUND(InData%ConnIdList,1) + IntKiBuf(Int_Xferred) = InData%ConnIdList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineStateIndList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4022,8 +3930,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIndList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineStateIndList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LineStateIndList))-1 ) = PACK(InData%LineStateIndList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LineStateIndList) + DO i1 = LBOUND(InData%LineStateIndList,1), UBOUND(InData%LineStateIndList,1) + IntKiBuf(Int_Xferred) = InData%LineStateIndList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4035,8 +3945,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MDWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MDWrOutput))-1 ) = PACK(InData%MDWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MDWrOutput) + DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%MDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackMisc @@ -4053,12 +3965,6 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4254,15 +4160,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FairIdList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FairIdList)>0) OutData%FairIdList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FairIdList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FairIdList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FairIdList,1), UBOUND(OutData%FairIdList,1) + OutData%FairIdList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnIdList not allocated Int_Xferred = Int_Xferred + 1 @@ -4277,15 +4178,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnIdList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ConnIdList)>0) OutData%ConnIdList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnIdList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnIdList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ConnIdList,1), UBOUND(OutData%ConnIdList,1) + OutData%ConnIdList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIndList not allocated Int_Xferred = Int_Xferred + 1 @@ -4300,15 +4196,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIndList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineStateIndList)>0) OutData%LineStateIndList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LineStateIndList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LineStateIndList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineStateIndList,1), UBOUND(OutData%LineStateIndList,1) + OutData%LineStateIndList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4323,15 +4214,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MDWrOutput)>0) OutData%MDWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MDWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MDWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) + OutData%MDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackMisc @@ -4505,38 +4391,38 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnects - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFairs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NLines - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%cBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dtM0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dtCoupling - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NTypes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnects + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFairs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConns + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAnchs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLines + 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 + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4578,12 +4464,12 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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:Int_Xferred+(1)-1 ) = InData%MDUnOut - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%MDUnOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_PackParam SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4599,12 +4485,6 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4619,38 +4499,38 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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 ) - Int_Xferred = Int_Xferred + 1 - OutData%NFairs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConns = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NLines = 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 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnects = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFairs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConns = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAnchs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NLines = 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) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4707,12 +4587,12 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MDUnOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%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 ) @@ -4869,12 +4749,6 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInput' @@ -5100,8 +4974,10 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackOutput @@ -5118,12 +4994,6 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5191,15 +5061,10 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackOutput @@ -5278,8 +5143,8 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5294,6 +5159,8 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE MD_Input_ExtrapInterp1 @@ -5325,8 +5192,9 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp2' @@ -5348,6 +5216,8 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE MD_Input_ExtrapInterp2 @@ -5427,12 +5297,12 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5445,15 +5315,15 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp1 @@ -5484,13 +5354,14 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5509,16 +5380,16 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp2 diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 915587467a..a32fbc3832 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -22,6 +22,7 @@ set(NWTCLIBS_SOURCES src/NWTC_IO.f90 src/NWTC_Library.f90 src/NWTC_Num.f90 + src/NWTC_RandomNumber.f90 src/SingPrec.f90 src/NWTC_Library_Types.f90 @@ -35,10 +36,45 @@ set(NWTCLIBS_SOURCES src/NetLib/fftpack/NWTC_FFTPACK.f90 src/NetLib/lapack/NWTC_LAPACK.f90 src/NetLib/scalapack/NWTC_ScaLAPACK.f90 - ) + + # NetLib SLATEC sources + src/NetLib/slatec/NWTC_SLATEC.f90 + src/NetLib/slatec/dqk61.f + src/NetLib/slatec/qk61.f + src/NetLib/slatec/d1mach.f + src/NetLib/slatec/r1mach.f + src/NetLib/slatec/xercnt.f + src/NetLib/slatec/xerhlt.f + src/NetLib/slatec/xerprn.f + src/NetLib/slatec/xersve.f + src/NetLib/slatec/fdump.f + src/NetLib/slatec/i1mach.f + src/NetLib/slatec/j4save.f + src/NetLib/slatec/xgetua.f + src/NetLib/slatec/xermsg.f ) get_filename_component(FCNAME ${CMAKE_Fortran_COMPILER} NAME) +# Recursive use of routine in qk61/dqk61 will trigger errors in debug +if (CMAKE_BUILD_TYPE MATCHES Debug) + if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") + set_source_files_properties(src/NetLib/slatec/NWTC_SLATEC.f90 PROPERTIES COMPILE_FLAGS -frecursive) + set_source_files_properties(src/NetLib/slatec/dqk61.f PROPERTIES COMPILE_FLAGS -frecursive) + set_source_files_properties(src/NetLib/slatec/qk61.f PROPERTIES COMPILE_FLAGS -frecursive) + elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") + if (WIN32) + set_source_files_properties(src/NetLib/slatec/NWTC_SLATEC.f90 PROPERTIES COMPILE_FLAGS "/assume:recursion") + set_source_files_properties(src/NetLib/slatec/dqk61.f PROPERTIES COMPILE_FLAGS "/assume:recursion") + set_source_files_properties(src/NetLib/slatec/qk61.f PROPERTIES COMPILE_FLAGS "/assume:recursion") + else() + set_source_files_properties(src/NetLib/slatec/NWTC_SLATEC.f90 PROPERTIES COMPILE_FLAGS "-assume recursion") + set_source_files_properties(src/NetLib/slatec/dqk61.f PROPERTIES COMPILE_FLAGS "-assume recursion") + set_source_files_properties(src/NetLib/slatec/qk61.f PROPERTIES COMPILE_FLAGS "-assume recursion") + endif() + endif() +endif() + + if(BUILD_OPENFAST_SIMULINK_API) if (APPLE OR UNIX) @@ -77,9 +113,9 @@ add_library(nwtclibs ${NWTCLIBS_SOURCES}) if(BUILD_OPENFAST_SIMULINK_API) find_package(Matlab REQUIRED) - target_link_libraries(nwtclibs ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS} ${Matlab_MEX_LIBRARY}) + target_link_libraries(nwtclibs versioninfolib ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS} ${Matlab_MEX_LIBRARY}) else() - target_link_libraries(nwtclibs ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS}) + target_link_libraries(nwtclibs versioninfolib ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS}) endif() install(TARGETS nwtclibs diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index bf717c14b3..a38dfdd723 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -91,6 +91,7 @@ SUBROUTINE MeshWrBin ( UnIn, M, ErrStat, ErrMsg, FileName) WRITE (UnIn, IOSTAT=ErrStat2) M%fieldmask ! BJJ: do we need to verify that this is size B4Ki? WRITE (UnIn, IOSTAT=ErrStat2) INT(M%Nnodes,B4Ki) WRITE (UnIn, IOSTAT=ErrStat2) INT(M%nelemlist,B4Ki) + if (M%Fieldmask(MASKID_SCALAR)) WRITE (UnIn, IOSTAT=ErrStat2) INT(M%nScalars,B4Ki) !........... @@ -1543,7 +1544,7 @@ SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeO ELSE ! initialized, may or may not be committed Int_BufSz = 3 & ! number of logicals in MeshType (initialized, committed, RemapFlag) + FIELDMASK_SIZE & ! number of logicals in MeshType (fieldmask) - + 4 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars) + + 5 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars, refNode) !...... ! we'll store the element structure (and call MeshCommit on Unpack if necessary to get the remaining fields like det_jac) @@ -1638,6 +1639,7 @@ SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeO ! integers IntKiBuf(Int_Xferred) = Mesh%ios; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nnodes; Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = Mesh%refnode; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nextelem; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nscalars; Int_Xferred = Int_Xferred + 1 @@ -1746,7 +1748,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) ! Local LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) - INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem + INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode INTEGER i,j INTEGER(IntKi) :: Re_Xferred ! number of reals transferred @@ -1780,6 +1782,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) ! integers ios = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nnodes = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 + refnode = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nextelem = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nscalars = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 @@ -1799,6 +1802,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + Mesh%RefNode = refnode Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem @@ -2013,7 +2017,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & IF ( CtrlCode .EQ. MESH_NEWCOPY .OR. CtrlCode .EQ. MESH_SIBLING .OR. CtrlCode .EQ. MESH_COUSIN ) THEN IF (CtrlCode .EQ. MESH_NEWCOPY) THEN - IOS_l = SrcMesh%IOS + IOS_l = SrcMesh%IOS Force_l = SrcMesh%FieldMask(MASKID_FORCE) Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) @@ -2195,6 +2199,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%Initialized = SrcMesh%Initialized DestMesh%Committed = SrcMesh%Committed + DestMesh%refNode = SrcMesh%refNode IF ( ALLOCATED(SrcMesh%Force ) .AND. ALLOCATED(DestMesh%Force ) ) DestMesh%Force = SrcMesh%Force IF ( ALLOCATED(SrcMesh%Moment ) .AND. ALLOCATED(DestMesh%Moment ) ) DestMesh%Moment = SrcMesh%Moment IF ( ALLOCATED(SrcMesh%Orientation ) .AND. ALLOCATED(DestMesh%Orientation ) ) DestMesh%Orientation = SrcMesh%Orientation @@ -2215,7 +2220,7 @@ END SUBROUTINE MeshCopy !! If an Orient argument is included, the node will also be assigned the specified orientation !! (orientation is assumed to be the identity matrix if omitted). Returns a non-zero value in !! ErrStat if Inode is outside the range 1..Nnodes. - SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) + SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient, Ref ) TYPE(MeshType), INTENT(INOUT) :: Mesh !< Mesh being spatio-located INTEGER(IntKi), INTENT(IN ) :: Inode !< Number of node being located @@ -2223,6 +2228,7 @@ SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error code CHARACTER(*), INTENT( OUT) :: ErrMess !< Error message REAL(R8Ki), OPTIONAL, INTENT(IN ) :: Orient(3,3) !< Orientation (direction cosine matrix) of node; identity by default + LOGICAL, OPTIONAL, INTENT(IN ) :: Ref ErrStat = ErrID_None ErrMess = "" @@ -2276,6 +2282,10 @@ SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) Mesh%RefOrientation(:,3,Inode) = (/ 0._R8Ki, 0._R8Ki, 1._R8Ki /) END IF + IF (PRESENT(Ref)) THEN + Mesh%RefNode = Inode + END IF + RETURN END SUBROUTINE MeshPositionNode @@ -2411,7 +2421,7 @@ SUBROUTINE MeshCommit( Mesh, ErrStat, ErrMess ) Mesh%ElemTable(ELEMENT_LINE2)%Elements(J)%det_jac = 0.5_ReKi * TwoNorm( n1_n2_vector ) ! = L / 2 - IF ( EqualRealNos( 2.0_ReKi*Mesh%ElemTable(ELEMENT_LINE2)%Elements(J)%det_jac, 0.0_Reki ) ) THEN + IF ( 2.0_ReKi*Mesh%ElemTable(ELEMENT_LINE2)%Elements(J)%det_jac < MIN_LINE2_ELEMENT_LENGTH ) THEN ErrStat = ErrID_Fatal ErrMess = trim(ErrMess)//"MeshCommit: Line2 element "//TRIM(Num2Lstr(j))//" has 0 length."//NewLine// & " n2 = n("//TRIM(Num2Lstr(n2))//") = ("//TRIM(Num2Lstr(Mesh%Position(1,n2)))//','//TRIM(Num2Lstr(mesh%position(2,n2)))//','//TRIM(Num2Lstr(mesh%position(3,n2))) //')'//NewLine// & @@ -2907,14 +2917,15 @@ SUBROUTINE PackLoadMesh_Names(M, MeshName, Names, indx_first) indx_first = indx_first + 1 end do end do - - do i=1,M%NNodes - do j=1,3 - Names(indx_first) = trim(MeshName)//' '//Comp(j)//' moment, node '//trim(num2lstr(i))//', Nm'//UnitDesc - indx_first = indx_first + 1 - end do - end do - + ! This is needed for MAP meshes because it only contains the Force field not the Moment field + if ( M%fieldmask(MASKID_Moment) .AND. ALLOCATED(M%Moment)) then + do i=1,M%NNodes + do j=1,3 + Names(indx_first) = trim(MeshName)//' '//Comp(j)//' moment, node '//trim(num2lstr(i))//', Nm'//UnitDesc + indx_first = indx_first + 1 + end do + end do + end if END SUBROUTINE PackLoadMesh_Names !............................................................................................................................... @@ -2936,14 +2947,16 @@ SUBROUTINE PackLoadMesh(M, Ary, indx_first) indx_first = indx_first + 1 end do end do - - do i=1,M%NNodes - do j=1,3 - Ary(indx_first) = M%Moment(j,i) - indx_first = indx_first + 1 - end do - end do - + + ! This is needed for MAP meshes because it only contains the Force field not the Moment field + if ( M%fieldmask(MASKID_Moment) .AND. ALLOCATED(M%Moment)) then + do i=1,M%NNodes + do j=1,3 + Ary(indx_first) = M%Moment(j,i) + indx_first = indx_first + 1 + end do + end do + end if END SUBROUTINE PackLoadMesh !............................................................................................................................... @@ -2966,11 +2979,14 @@ SUBROUTINE PackLoadMesh_dY(M_p, M_m, dY, indx_first) indx_first = indx_last + 1 end do - do i=1,M_p%NNodes - indx_last = indx_first + 2 - dY(indx_first:indx_last) = M_p%Moment(:,i) - M_m%Moment(:,i) - indx_first = indx_last + 1 - end do + ! This is needed for MAP meshes because it only contains the Force field not the Moment field + if ( M_p%fieldmask(MASKID_Moment) .AND. ALLOCATED(M_p%Moment)) then + do i=1,M_p%NNodes + indx_last = indx_first + 2 + dY(indx_first:indx_last) = M_p%Moment(:,i) - M_m%Moment(:,i) + indx_first = indx_last + 1 + end do + end if END SUBROUTINE PackLoadMesh_dY !............................................................................................................................... @@ -3058,17 +3074,23 @@ END SUBROUTINE PackMotionMesh_Names !> This subroutine returns the operating point values of the mesh fields. It assumes all fields marked !! by FieldMask are allocated; Some fields may be allocated by the ModMesh module and not used in !! the linearization procedure, thus I am not using the check if they are allocated to determine if they should be included. - SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask) + SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask, UseLogMaps) TYPE(MeshType) , INTENT(IN ) :: M !< Motion mesh REAL(ReKi) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into INTEGER(IntKi) , INTENT(INOUT) :: indx_first !< index into Ary; gives location of next array position to fill LOGICAL, OPTIONAL , INTENT(IN ) :: FieldMask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + LOGICAL, OPTIONAL , INTENT(IN ) :: UseLogMaps !< flag to determine if the orientation should be packed as a DCM or a log map ! local variables: INTEGER(IntKi) :: i, j, k LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + LOGICAL :: OutputLogMap + REAL(R8Ki) :: logmap(3) !< array to pack logmaps into + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + if (present(FieldMask)) then Mask = FieldMask @@ -3087,14 +3109,30 @@ SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask) end if if (Mask(MASKID_ORIENTATION)) then - do i=1,M%NNodes - do j=1,3 - do k=1,3 ! note this gives us 9 values instead of 3 for this "operating point" - Ary(indx_first) = M%Orientation(j,k,i) + if (present(UseLogMaps)) then + OutputLogMap = UseLogMaps + else + OutputLogMap = .false. + end if + + if (OutputLogMap) then + do i=1,M%NNodes + call DCM_logMap(M%Orientation(:,:,i), logmap, ErrStat2, ErrMsg2) + do k=1,3 + Ary(indx_first) = logmap(k) indx_first = indx_first + 1 - end do - end do - end do + end do + end do + else + do i=1,M%NNodes + do j=1,3 + do k=1,3 ! note this gives us 9 values instead of 3 for this "operating point" + Ary(indx_first) = M%Orientation(j,k,i) + indx_first = indx_first + 1 + end do + end do + end do + end if end if if (Mask(MASKID_TRANSLATIONVEL)) then @@ -3150,8 +3188,9 @@ SUBROUTINE PackMotionMesh_dY(M_p, M_m, dY, indx_first, FieldMask) CHARACTER(ErrMsgLen) :: ErrMsg2 INTEGER(IntKi) :: i, indx_last + REAL(R8Ki) :: lambda_m(3) + REAL(R8Ki) :: lambda_p(3) REAL(R8Ki) :: smallAngles(3) - REAL(R8Ki) :: orientation(3,3) LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing if (present(FieldMask)) then @@ -3171,10 +3210,10 @@ SUBROUTINE PackMotionMesh_dY(M_p, M_m, dY, indx_first, FieldMask) if (Mask(MASKID_ORIENTATION)) then do i=1,M_p%NNodes - orientation = transpose(M_m%Orientation(:,:,i)) - orientation = matmul(orientation, M_p%Orientation(:,:,i)) - - smallAngles = GetSmllRotAngs( orientation, ErrStat2, ErrMsg2 ) + call DCM_logMap( M_m%Orientation(:,:,i), lambda_m, ErrStat2, ErrMsg2 ) + call DCM_logMap( M_p%Orientation(:,:,i), lambda_p, ErrStat2, ErrMsg2 ) + + smallAngles = lambda_p - lambda_m indx_last = indx_first + 2 dY(indx_first:indx_last) = smallAngles @@ -3381,7 +3420,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) if ( size(t) .ne. order+1) then ErrStat = ErrID_Fatal - ErrMsg = 'MeshExtrapInterp2: size(t) must equal 2.' + ErrMsg = 'MeshExtrapInterp2: size(t) must equal 3.' RETURN end if diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index c2a13e4ee0..6a56316bca 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -59,13 +59,13 @@ MODULE ModMesh_Mapping REAL(R8Ki), ALLOCATABLE :: M_uS(:,:) !< block matrix of moment that is multiplied by Source u (translationDisp) [-] REAL(R8Ki), ALLOCATABLE :: M_uD(:,:) !< block matrix of moment that is multiplied by Destination u (translationDisp) [-] REAL(R8Ki), ALLOCATABLE :: M_f(:,:) !< block matrix of moment that is multiplied by force [-] - END TYPE + END TYPE MeshMapLinearizationType !> data structures to determine full mapping between fields on different meshes TYPE, PUBLIC :: MeshMapType - TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping for load fields - TYPE(MapType), ALLOCATABLE :: MapMotions(:) !< mapping for motion fields + 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 @@ -73,13 +73,13 @@ MODULE ModMesh_Mapping 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 :: 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) TYPE(MeshMapLinearizationType) :: dM !< type that contains information for linearization matrices, partial M partial u (or y) - END TYPE + END TYPE MeshMapType ! note that these parameters must be negative (positive indicates the node/element it is mapped to) INTEGER(IntKi), PARAMETER :: NODE_NOT_MAPPED = -1 !< constant that indicates a node is not mapped @@ -391,7 +391,7 @@ SUBROUTINE MeshMapWrBin( UnIn, Src, Dest, MeshMap, ErrStat, ErrMsg, FileName ) IF ( HasLoadFields(Src) ) THEN WRITE (UnIn, IOSTAT=ErrStat2) INT(1,B4Ki) ! contains a load field - MapMat = 0.0_ReKi + MapMat = 0.0_ReKi IF ( Src%ElemTable(ELEMENT_POINT)%Nelem > 0 ) THEN DO i=1,Src%Nnodes j=MeshMap%MapLoads(i)%OtherMesh_Element @@ -1227,6 +1227,7 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg ! local variables INTEGER(IntKi) :: i , j ! counter over the nodes INTEGER(IntKi) :: k ! counter components + INTEGER(IntKi) :: nScalars ! number of scalars transferred INTEGER(IntKi) :: n, n1, n2 ! temporary space for node numbers REAL(R8Ki) :: FieldValueN1(3) ! Temporary variable to store field values on element nodes REAL(R8Ki) :: FieldValueN2(3) ! Temporary variable to store field values on element nodes @@ -1495,14 +1496,21 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg !! \phi_i\f$ if (Src%FieldMask(MASKID_SCALAR) .AND. Dest%FieldMask(MASKID_SCALAR) ) then + nScalars = min(Dest%nScalars, Src%nScalars) + + if (Dest%nScalars > nScalars) then + call SetErrStat(ErrID_Severe, "Not all scalars could be computed from source mesh (insufficient data).", ErrStat, ErrMsg, 'Transfer_Motions_Line2_to_Point') + Dest%Scalars(nScalars+1:,:) = 0.0_ReKi + end if + do i=1, Dest%Nnodes !if ( MeshMap%MapMotions(i)%OtherMesh_Element < 1 ) CYCLE n1 = Src%ElemTable(ELEMENT_LINE2)%Elements(MeshMap%MapMotions(i)%OtherMesh_Element)%ElemNodes(1) n2 = Src%ElemTable(ELEMENT_LINE2)%Elements(MeshMap%MapMotions(i)%OtherMesh_Element)%ElemNodes(2) - Dest%Scalars(:,i) = MeshMap%MapMotions(i)%shape_fn(1)*Src%Scalars(:,n1) & - + MeshMap%MapMotions(i)%shape_fn(2)*Src%Scalars(:,n2) + Dest%Scalars(1:nScalars,i) = MeshMap%MapMotions(i)%shape_fn(1)*Src%Scalars(1:nScalars,n1) & + + MeshMap%MapMotions(i)%shape_fn(2)*Src%Scalars(1:nScalars,n2) end do end if @@ -1941,7 +1949,7 @@ SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrSt ! if failed to find an element that the Point projected into, throw an error if (.not. found) then - if ( closest_elem_distance < 5.0e-3 ) then ! if it is within 5mm of the end of an element, we'll accept it + if ( closest_elem_distance <= 7.5e-3 ) then ! if it is within 7.5mm of the end of an element, we'll accept it NodeMap(i)%OtherMesh_Element = closest_elem NodeMap(i)%shape_fn(1) = 1.0_ReKi - closest_elem_position NodeMap(i)%shape_fn(2) = closest_elem_position @@ -1949,7 +1957,8 @@ SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrSt end if if (NodeMap(i)%OtherMesh_Element .lt. 1 ) then - CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.', ErrStat, ErrMsg, RoutineName) + CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.' & + //' Closest distance is '//trim(num2lstr(closest_elem_distance))//' m.', ErrStat, ErrMsg, RoutineName) #ifdef DEBUG_MESHMAPPING ! output some mesh information for debugging @@ -2625,6 +2634,7 @@ SUBROUTINE Transfer_Motions_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables + INTEGER(IntKi) :: nScalars INTEGER(IntKi) :: i, j ! counter over the nodes REAL(R8Ki) :: RotationMatrix(3,3) REAL(ReKi) :: TmpVec(3) @@ -2773,10 +2783,17 @@ SUBROUTINE Transfer_Motions_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg !> Scalars: \f$S^D = S^S\f$ if (Src%FieldMask(MASKID_SCALAR) .AND. Dest%FieldMask(MASKID_SCALAR) ) then + nScalars = min(Dest%nScalars, Src%nScalars) + + if (Dest%nScalars > nScalars) then + call SetErrStat(ErrID_Severe, "Not all scalars could be computed from source mesh (insufficient data).", ErrStat, ErrMsg, 'Transfer_Motions_Point_to_Point') + Dest%Scalars(nScalars+1:,:) = 0.0_ReKi + end if + do i=1, Dest%Nnodes !if ( MeshMap%MapMotions(i)%OtherMesh_Element < 1 ) CYCLE - Dest%Scalars(:,i) = Src%Scalars(:,MeshMap%MapMotions(i)%OtherMesh_Element) + Dest%Scalars(1:nScalars,i) = Src%Scalars(1:nScalars,MeshMap%MapMotions(i)%OtherMesh_Element) end do end if @@ -4217,6 +4234,7 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, INTEGER(IntKi) :: Aug_NElem, curr_Aug_NElem INTEGER(IntKi) :: n1, n2 REAL(ReKi) :: p_ED(3), p_ES(3), n1S_nD_vector(3), position(3) + REAL(ReKi) :: p_ED_orig(3), denom_orig REAL(R8Ki) :: RefOrientation(3,3) REAL(DbKi) :: TmpVec(3), RefOrientationD(3,3), FieldValue(3,2) ! values for interpolating direction cosine matrices REAL(ReKi) :: denom, elem_position @@ -4320,6 +4338,7 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, IF ( Dest_TYPE == ELEMENT_LINE2 ) THEN p_eD = dest%Position(:, dest%ElemTable(Dest_TYPE)%Elements(jElem)%ElemNodes(2)) & - dest%Position(:, dest%ElemTable(Dest_TYPE)%Elements(jElem)%ElemNodes(1)) + p_eD_orig = p_eD ! save for later calculations (to allow point elements, too) END IF @@ -4337,11 +4356,11 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, IF ( .NOT. EqualRealNos( denom, 0.0_ReKi) ) THEN ! we ignore source elements that are parallel to the destination element (i.e., denom == 0) - DO jNode = j, NumNodes( Dest_TYPE ) + DO jNode = j, NumNodes( Dest_TYPE ) ! check each node of the destination element n1S_nD_vector = dest%Position(:, dest%ElemTable(Dest_TYPE)%Elements(jElem)%ElemNodes(jNode)) & - Temp_Ln2_Src%Position(:, Temp_Ln2_Src%ElemTable(ELEMENT_LINE2)%Elements(iElem)%ElemNodes(1)) - elem_position = DOT_PRODUCT( p_eD, n1S_nD_vector ) / denom + elem_position = DOT_PRODUCT( p_eD, n1S_nD_vector ) / denom ! Eq 37 (AIAA 2015 paper) !bjj: todo: we need to set this TOL based on actual distances, not relative values (0,1) on an element.... ! for now, I've calculated the element length inside this tolerance and reserve the right to reject new nodes that create 0-length elements. @@ -4356,14 +4375,14 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, ! calculate the position and orientation relative to the *original* source element: n1=Src%ElemTable(ELEMENT_LINE2)%Elements(Original_Src_Element(iElem))%ElemNodes(1) n2=Src%ElemTable(ELEMENT_LINE2)%Elements(Original_Src_Element(iElem))%ElemNodes(2) - + p_eS = Src%Position(:, n2) - Src%Position(:, n1) - IF ( Dest_TYPE == ELEMENT_POINT ) p_eD = p_eS - denom = DOT_PRODUCT( p_eD , p_eS ) ! we don't need to check that this is zero because it's just a shorter version of the temp Temp_Ln2_Src element + IF ( Dest_TYPE == ELEMENT_POINT ) p_eD_orig = p_eS + denom_orig = DOT_PRODUCT( p_eD_orig , p_eS ) ! we don't need to check that this is zero because it's just a shorter version of the temp Temp_Ln2_Src element n1S_nD_vector = dest%Position(:, dest%ElemTable(Dest_TYPE)%Elements(jElem)%ElemNodes(jNode)) & - Src%Position(:, n1 ) - shape_fn2(Aug_Nnodes) = DOT_PRODUCT( p_eD, n1S_nD_vector ) / denom ! save this for later, when we need to map the mesh fields... + shape_fn2(Aug_Nnodes) = DOT_PRODUCT( p_eD_orig, n1S_nD_vector ) / denom_orig ! save this for later, when we need to map the mesh fields... ! interpolate position on the original souce element: @@ -4372,19 +4391,19 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, ! let's just verify that this new node (n1) doesn't give us zero-length elements: ! (note we use the NEW (not original) source element, which may have been split) - p_eS = position - Temp_Ln2_Src%Position(:, Temp_Ln2_Src%ElemTable(ELEMENT_LINE2)%Elements(iElem)%ElemNodes(1) ) + p_eS = position - Temp_Ln2_Src%Position(:, Temp_Ln2_Src%ElemTable(ELEMENT_LINE2)%Elements(iElem)%ElemNodes(1) ) L = SQRT(dot_product(p_eS,p_eS)) ! length of new element - - IF ( L < TOL ) THEN ! this element is basically zero length + + IF ( L < MIN_LINE2_ELEMENT_LENGTH ) THEN ! this element is basically zero length ! for numerical reasons, we really didn't want this node.... - Aug_Nnodes = Aug_Nnodes - 1 + Aug_Nnodes = Aug_Nnodes - 1 ELSE ! let's verify the other node (n2) of this element doesn't give zero-length: - p_eS = position - Temp_Ln2_Src%Position(:, Temp_Ln2_Src%ElemTable(ELEMENT_LINE2)%Elements(iElem)%ElemNodes(2)) + p_eS = position - Temp_Ln2_Src%Position(:, Temp_Ln2_Src%ElemTable(ELEMENT_LINE2)%Elements(iElem)%ElemNodes(2)) L = SQRT(dot_product(p_eS,p_eS)) ! length of new element - IF ( L < TOL ) THEN ! this element is basically zero length + IF ( L < MIN_LINE2_ELEMENT_LENGTH ) THEN ! this element is basically zero length ! for numerical reasons, we really didn't want this node.... Aug_Nnodes = Aug_Nnodes - 1 ELSE @@ -4398,45 +4417,31 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, RETURN END IF - Original_Src_Element( Aug_NElem ) = Original_Src_Element( iElem ) ! this node can now be mapped to original source mesh element + Original_Src_Element( Aug_NElem ) = Original_Src_Element( iElem ) ! this node can now be mapped to original source mesh element - ! get the Reference orientation for this new node -#ifdef __NN_ORIENTATIONS - ! set the RefOrientation based on proximity to original element's nodes: - IF ( NINT( shape_fn2(Aug_Nnodes) ) .EQ. 0 ) THEN - n = n1 - ELSE - n = n2 - END IF - RefOrientation = Src%RefOrientation(:, :, n) -#else - - ! convert DCMs to tensors: + ! get the Reference orientation for this new node + ! convert DCMs to tensors: - RefOrientationD = Src%RefOrientation(:, :, n1) - CALL DCM_logmap( RefOrientationD, FieldValue(:,1), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN + RefOrientationD = Src%RefOrientation(:, :, n1) + CALL DCM_logmap( RefOrientationD, FieldValue(:,1), ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN - RefOrientationD = Src%RefOrientation(:, :, n2) - CALL DCM_logmap( RefOrientationD, FieldValue(:,2), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN + RefOrientationD = Src%RefOrientation(:, :, n2) + CALL DCM_logmap( RefOrientationD, FieldValue(:,2), ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN - CALL DCM_SetLogMapForInterp( FieldValue ) ! make sure we don't cross a 2pi boundary + CALL DCM_SetLogMapForInterp( FieldValue ) ! make sure we don't cross a 2pi boundary - ! interpolate tensors: - TmpVec = (1.0_ReKi - shape_fn2(Aug_Nnodes)) * FieldValue(:, 1) & - + shape_fn2(Aug_Nnodes) * FieldValue(:, 2) + ! interpolate tensors: + TmpVec = (1.0_ReKi - shape_fn2(Aug_Nnodes)) * FieldValue(:, 1) & + + shape_fn2(Aug_Nnodes) * FieldValue(:, 2) - ! convert back to DCM: - RefOrientationD = DCM_exp( TmpVec ) - RefOrientation = REAL(RefOrientationD, R8Ki) + ! convert back to DCM: + RefOrientationD = DCM_exp( TmpVec ) + RefOrientation = REAL(RefOrientationD, R8Ki) - -#endif - - CALL MeshPositionNode ( Mesh = Temp_Ln2_Src & ,INode = Aug_Nnodes & ,Pos = position & @@ -4446,10 +4451,10 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() - RETURN + RETURN END IF - ! if we have to check a second node, we need to first recalculate p_eS and denom on Temp_Ln2_Src: + ! if we have to check a second node, we need to first recalculate p_eS and denom on Temp_Ln2_Src: IF ( jNode < NumNodes( Dest_TYPE )) THEN j = jNode+1 ! start on the next node CYCLE Src_Elements @@ -5540,7 +5545,7 @@ SUBROUTINE WriteMappingTransferToFile(Mesh1_I,Mesh1_O,Mesh2_I,Mesh2_O,Map_Mod1_M INTEGER(IntKi) :: i INTEGER(IntKi) :: un_out INTEGER(IntKi) :: ErrStat ! Error status of the operation - CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None CHARACTER(256) :: PrintWarnF, PrintWarnM, TmpValues #ifdef MESH_DEBUG @@ -5863,14 +5868,18 @@ SUBROUTINE NWTC_Library_PackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OtherMesh_Element - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%distance - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%couple_arm))-1 ) = PACK(InData%couple_arm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%couple_arm) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%shape_fn))-1 ) = PACK(InData%shape_fn,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%shape_fn) + IntKiBuf(Int_Xferred) = InData%OtherMesh_Element + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%distance + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%couple_arm,1), UBOUND(InData%couple_arm,1) + DbKiBuf(Db_Xferred) = InData%couple_arm(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%shape_fn,1), UBOUND(InData%shape_fn,1) + DbKiBuf(Db_Xferred) = InData%shape_fn(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_PackMapType SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5886,12 +5895,6 @@ SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5908,32 +5911,22 @@ SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%OtherMesh_Element = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%OtherMesh_Element = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%couple_arm,1) i1_u = UBOUND(OutData%couple_arm,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%couple_arm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%couple_arm))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%couple_arm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%couple_arm,1), UBOUND(OutData%couple_arm,1) + OutData%couple_arm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%shape_fn,1) i1_u = UBOUND(OutData%shape_fn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%shape_fn = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%shape_fn))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%shape_fn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%shape_fn,1), UBOUND(OutData%shape_fn,1) + OutData%shape_fn(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_UnPackMapType SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -6282,8 +6275,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mi))-1 ) = PACK(InData%mi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mi) + DO i2 = LBOUND(InData%mi,2), UBOUND(InData%mi,2) + DO i1 = LBOUND(InData%mi,1), UBOUND(InData%mi,1) + DbKiBuf(Db_Xferred) = InData%mi(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fx_p) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6298,8 +6295,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fx_p)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%fx_p))-1 ) = PACK(InData%fx_p,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%fx_p) + DO i2 = LBOUND(InData%fx_p,2), UBOUND(InData%fx_p,2) + DO i1 = LBOUND(InData%fx_p,1), UBOUND(InData%fx_p,1) + DbKiBuf(Db_Xferred) = InData%fx_p(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tv_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6314,8 +6315,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tv_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tv_uD))-1 ) = PACK(InData%tv_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tv_uD) + DO i2 = LBOUND(InData%tv_uD,2), UBOUND(InData%tv_uD,2) + DO i1 = LBOUND(InData%tv_uD,1), UBOUND(InData%tv_uD,1) + DbKiBuf(Db_Xferred) = InData%tv_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tv_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6330,8 +6335,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tv_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tv_uS))-1 ) = PACK(InData%tv_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tv_uS) + DO i2 = LBOUND(InData%tv_uS,2), UBOUND(InData%tv_uS,2) + DO i1 = LBOUND(InData%tv_uS,1), UBOUND(InData%tv_uS,1) + DbKiBuf(Db_Xferred) = InData%tv_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6346,8 +6355,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_uD))-1 ) = PACK(InData%ta_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_uD) + DO i2 = LBOUND(InData%ta_uD,2), UBOUND(InData%ta_uD,2) + DO i1 = LBOUND(InData%ta_uD,1), UBOUND(InData%ta_uD,1) + DbKiBuf(Db_Xferred) = InData%ta_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6362,8 +6375,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_uS))-1 ) = PACK(InData%ta_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_uS) + DO i2 = LBOUND(InData%ta_uS,2), UBOUND(InData%ta_uS,2) + DO i1 = LBOUND(InData%ta_uS,1), UBOUND(InData%ta_uS,1) + DbKiBuf(Db_Xferred) = InData%ta_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_rv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6378,8 +6395,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_rv)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_rv))-1 ) = PACK(InData%ta_rv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_rv) + DO i2 = LBOUND(InData%ta_rv,2), UBOUND(InData%ta_rv,2) + DO i1 = LBOUND(InData%ta_rv,1), UBOUND(InData%ta_rv,1) + DbKiBuf(Db_Xferred) = InData%ta_rv(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%li) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6394,8 +6415,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%li)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%li))-1 ) = PACK(InData%li,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%li) + DO i2 = LBOUND(InData%li,2), UBOUND(InData%li,2) + DO i1 = LBOUND(InData%li,1), UBOUND(InData%li,1) + DbKiBuf(Db_Xferred) = InData%li(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6410,8 +6435,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_uS))-1 ) = PACK(InData%M_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_uS) + DO i2 = LBOUND(InData%M_uS,2), UBOUND(InData%M_uS,2) + DO i1 = LBOUND(InData%M_uS,1), UBOUND(InData%M_uS,1) + DbKiBuf(Db_Xferred) = InData%M_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6426,8 +6455,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_uD))-1 ) = PACK(InData%M_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_uD) + DO i2 = LBOUND(InData%M_uD,2), UBOUND(InData%M_uD,2) + DO i1 = LBOUND(InData%M_uD,1), UBOUND(InData%M_uD,1) + DbKiBuf(Db_Xferred) = InData%M_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_f) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6442,8 +6475,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_f)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_f))-1 ) = PACK(InData%M_f,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_f) + DO i2 = LBOUND(InData%M_f,2), UBOUND(InData%M_f,2) + DO i1 = LBOUND(InData%M_f,1), UBOUND(InData%M_f,1) + DbKiBuf(Db_Xferred) = InData%M_f(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_PackMeshMapLinearizationType @@ -6460,12 +6497,6 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6497,15 +6528,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%mi)>0) OutData%mi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mi))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%mi,2), UBOUND(OutData%mi,2) + DO i1 = LBOUND(OutData%mi,1), UBOUND(OutData%mi,1) + OutData%mi(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx_p not allocated Int_Xferred = Int_Xferred + 1 @@ -6523,15 +6551,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fx_p)>0) OutData%fx_p = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%fx_p))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%fx_p) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fx_p,2), UBOUND(OutData%fx_p,2) + DO i1 = LBOUND(OutData%fx_p,1), UBOUND(OutData%fx_p,1) + OutData%fx_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6549,15 +6574,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tv_uD)>0) OutData%tv_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tv_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tv_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tv_uD,2), UBOUND(OutData%tv_uD,2) + DO i1 = LBOUND(OutData%tv_uD,1), UBOUND(OutData%tv_uD,1) + OutData%tv_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6575,15 +6597,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tv_uS)>0) OutData%tv_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tv_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tv_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tv_uS,2), UBOUND(OutData%tv_uS,2) + DO i1 = LBOUND(OutData%tv_uS,1), UBOUND(OutData%tv_uS,1) + OutData%tv_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6601,15 +6620,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_uD)>0) OutData%ta_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_uD,2), UBOUND(OutData%ta_uD,2) + DO i1 = LBOUND(OutData%ta_uD,1), UBOUND(OutData%ta_uD,1) + OutData%ta_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6627,15 +6643,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_uS)>0) OutData%ta_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_uS,2), UBOUND(OutData%ta_uS,2) + DO i1 = LBOUND(OutData%ta_uS,1), UBOUND(OutData%ta_uS,1) + OutData%ta_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_rv not allocated Int_Xferred = Int_Xferred + 1 @@ -6653,15 +6666,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_rv)>0) OutData%ta_rv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_rv))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_rv) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_rv,2), UBOUND(OutData%ta_rv,2) + DO i1 = LBOUND(OutData%ta_rv,1), UBOUND(OutData%ta_rv,1) + OutData%ta_rv(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! li not allocated Int_Xferred = Int_Xferred + 1 @@ -6679,15 +6689,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%li)>0) OutData%li = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%li))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%li) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%li,2), UBOUND(OutData%li,2) + DO i1 = LBOUND(OutData%li,1), UBOUND(OutData%li,1) + OutData%li(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6705,15 +6712,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_uS)>0) OutData%M_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_uS,2), UBOUND(OutData%M_uS,2) + DO i1 = LBOUND(OutData%M_uS,1), UBOUND(OutData%M_uS,1) + OutData%M_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6731,15 +6735,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_uD)>0) OutData%M_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_uD,2), UBOUND(OutData%M_uD,2) + DO i1 = LBOUND(OutData%M_uD,1), UBOUND(OutData%M_uD,1) + OutData%M_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_f not allocated Int_Xferred = Int_Xferred + 1 @@ -6757,15 +6758,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_f)>0) OutData%M_f = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_f))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_f) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_f,2), UBOUND(OutData%M_f,2) + DO i1 = LBOUND(OutData%M_f,1), UBOUND(OutData%M_f,1) + OutData%M_f(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType @@ -6868,20 +6866,6 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, END IF DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F -ENDIF IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat)) THEN i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) @@ -6896,6 +6880,20 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, END IF DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat ENDIF +IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN + i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) + i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) + i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) + i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) + IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN + ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F +ENDIF IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_M)) THEN i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,1) i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,1) @@ -6950,12 +6948,12 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(MeshMapTypeData%DisplacedPosition)) THEN DEALLOCATE(MeshMapTypeData%DisplacedPosition) ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_F) -ENDIF IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat) ENDIF +IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN + DEALLOCATE(MeshMapTypeData%LoadLn2_F) +ENDIF IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_M) ENDIF @@ -7111,16 +7109,16 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Int_BufSz = Int_BufSz + 2*3 ! DisplacedPosition upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%DisplacedPosition) ! DisplacedPosition END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F - END IF Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat allocated yes/no IF ( ALLOCATED(InData%LoadLn2_A_Mat) ) THEN Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_A_Mat upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_A_Mat) ! LoadLn2_A_Mat END IF + Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no + IF ( ALLOCATED(InData%LoadLn2_F) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F + END IF Int_BufSz = Int_BufSz + 1 ! LoadLn2_M allocated yes/no IF ( ALLOCATED(InData%LoadLn2_M) ) THEN Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_M upper/lower bounds for each dimension @@ -7359,8 +7357,10 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat_Piv,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_A_Mat_Piv)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LoadLn2_A_Mat_Piv))-1 ) = PACK(InData%LoadLn2_A_Mat_Piv,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LoadLn2_A_Mat_Piv) + DO i1 = LBOUND(InData%LoadLn2_A_Mat_Piv,1), UBOUND(InData%LoadLn2_A_Mat_Piv,1) + IntKiBuf(Int_Xferred) = InData%LoadLn2_A_Mat_Piv(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DisplacedPosition) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7378,40 +7378,54 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DisplacedPosition)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DisplacedPosition))-1 ) = PACK(InData%DisplacedPosition,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DisplacedPosition) + DO i3 = LBOUND(InData%DisplacedPosition,3), UBOUND(InData%DisplacedPosition,3) + DO i2 = LBOUND(InData%DisplacedPosition,2), UBOUND(InData%DisplacedPosition,2) + DO i1 = LBOUND(InData%DisplacedPosition,1), UBOUND(InData%DisplacedPosition,1) + DbKiBuf(Db_Xferred) = InData%DisplacedPosition(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) THEN + IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_F)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_F))-1 ) = PACK(InData%LoadLn2_F,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_F) + DO i2 = LBOUND(InData%LoadLn2_A_Mat,2), UBOUND(InData%LoadLn2_A_Mat,2) + DO i1 = LBOUND(InData%LoadLn2_A_Mat,1), UBOUND(InData%LoadLn2_A_Mat,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_A_Mat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN + IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_A_Mat)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_A_Mat))-1 ) = PACK(InData%LoadLn2_A_Mat,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_A_Mat) + DO i2 = LBOUND(InData%LoadLn2_F,2), UBOUND(InData%LoadLn2_F,2) + DO i1 = LBOUND(InData%LoadLn2_F,1), UBOUND(InData%LoadLn2_F,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_F(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LoadLn2_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7426,8 +7440,12 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_M)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_M))-1 ) = PACK(InData%LoadLn2_M,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_M) + DO i2 = LBOUND(InData%LoadLn2_M,2), UBOUND(InData%LoadLn2_M,2) + DO i1 = LBOUND(InData%LoadLn2_M,1), UBOUND(InData%LoadLn2_M,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_M(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, OnlySize ) ! dM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7472,12 +7490,6 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -7755,15 +7767,10 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LoadLn2_A_Mat_Piv)>0) OutData%LoadLn2_A_Mat_Piv = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LoadLn2_A_Mat_Piv))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LoadLn2_A_Mat_Piv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LoadLn2_A_Mat_Piv,1), UBOUND(OutData%LoadLn2_A_Mat_Piv,1) + OutData%LoadLn2_A_Mat_Piv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisplacedPosition not allocated Int_Xferred = Int_Xferred + 1 @@ -7784,17 +7791,16 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DisplacedPosition)>0) OutData%DisplacedPosition = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DisplacedPosition))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DisplacedPosition) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DisplacedPosition,3), UBOUND(OutData%DisplacedPosition,3) + DO i2 = LBOUND(OutData%DisplacedPosition,2), UBOUND(OutData%DisplacedPosition,2) + DO i1 = LBOUND(OutData%DisplacedPosition,1), UBOUND(OutData%DisplacedPosition,1) + OutData%DisplacedPosition(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7804,23 +7810,20 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) - ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) + ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_F)>0) OutData%LoadLn2_F = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_F))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_A_Mat,2), UBOUND(OutData%LoadLn2_A_Mat,2) + DO i1 = LBOUND(OutData%LoadLn2_A_Mat,1), UBOUND(OutData%LoadLn2_A_Mat,1) + OutData%LoadLn2_A_Mat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7830,21 +7833,18 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) - ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) + ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_A_Mat)>0) OutData%LoadLn2_A_Mat = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_A_Mat))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_A_Mat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_F,2), UBOUND(OutData%LoadLn2_F,2) + DO i1 = LBOUND(OutData%LoadLn2_F,1), UBOUND(OutData%LoadLn2_F,1) + OutData%LoadLn2_F(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_M not allocated Int_Xferred = Int_Xferred + 1 @@ -7862,15 +7862,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_M)>0) OutData%LoadLn2_M = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_M))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_M,2), UBOUND(OutData%LoadLn2_M,2) + DO i1 = LBOUND(OutData%LoadLn2_M,1), UBOUND(OutData%LoadLn2_M,1) + OutData%LoadLn2_M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 diff --git a/modules/nwtc-library/src/ModMesh_Types.f90 b/modules/nwtc-library/src/ModMesh_Types.f90 index f4c82f3977..1bca2c98a9 100644 --- a/modules/nwtc-library/src/ModMesh_Types.f90 +++ b/modules/nwtc-library/src/ModMesh_Types.f90 @@ -71,6 +71,10 @@ MODULE ModMesh_Types LOGICAL, PARAMETER :: mesh_debug = .FALSE. + +! REAL(ReKi), PARAMETER :: MIN_LINE2_ELEMENT_LENGTH = 0.001 ! 1 millimeter + REAL(ReKi), PARAMETER :: MIN_LINE2_ELEMENT_LENGTH = sqrt(epsilon(1.0_ReKi)) ! old length + !> element record type: fields for a particular element TYPE, PUBLIC :: ElemRecType ! note: any fields added to this type must be copied in Mesh_MoveAlloc_ElemRecType (modmesh_types::mesh_movealloc_elemrectype) @@ -101,6 +105,7 @@ MODULE ModMesh_Types LOGICAL :: fieldmask(FIELDMASK_SIZE) = .FALSE. !< Dimension as number of allocatable fields, below LOGICAL,POINTER :: RemapFlag => NULL() !< false=no action/ignore; true=remap required INTEGER :: ios !< Mesh type: input (1), output(2), or state(3) + INTEGER :: refNode = 0 !< optional reference node (informational only) INTEGER :: Nnodes = 0 !< Number of nodes (vertices) in mesh ! Mesh elements diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index f59e9b97ae..bd3ff35b4f 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -35,8 +35,8 @@ MODULE NWTC_Base INTEGER, PARAMETER :: BITS_IN_ADDR = C_INTPTR_T*8 !< The number of bits in an address (32-bit or 64-bit). INTEGER, PARAMETER :: ErrMsgLen = 1024 !< The maximum number of characters in an error message in the FAST framework - INTEGER(IntKi), PARAMETER :: ChanLen = 10 !< The allowable length of channel names (i.e., width of output columns) in the FAST framework - INTEGER(IntKi), PARAMETER :: ChanLenFF = 14 !< The allowable length of channel names (i.e., width of output columns) in the FAST.Farm software + 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 :: 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 :: NWTC_Verbose = 10 !< The maximum level of verbosity diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 77bdede750..457f3b5dc9 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -20,8 +20,10 @@ !> This module contains I/O-related variables and routines with non-system-specific logic. MODULE NWTC_IO - USE SysSubs - USE NWTC_Library_Types ! ProgDesc and other types with copy and other routines for those types + USE SysSubs + USE NWTC_Library_Types ! ProgDesc and other types with copy and other routines for those types + USE IEEE_ARITHMETIC + USE VersionInfo IMPLICIT NONE @@ -51,7 +53,8 @@ MODULE NWTC_IO INTEGER(B2Ki), PARAMETER :: FileFmtID_WithTime = 1 !< ID for FAST Output File Format, specifies that the time channel is included in the output file (use if the output can occur at variable times) INTEGER(B2Ki), PARAMETER :: FileFmtID_WithoutTime = 2 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output) - INTEGER(B2Ki), PARAMETER :: FileFmtID_NoCompressWithoutTime = 3 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output), and data is not compressed, but written as double precision floats + INTEGER(B2Ki), PARAMETER :: FileFmtID_NoCompressWithoutTime = 3 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output), and data is not compressed, but written as double-precision floats + INTEGER(B2Ki), PARAMETER :: FileFmtID_ChanLen_In = 4 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file, and channel length is included in the file LOGICAL :: Beep = .TRUE. !< Flag that specifies whether or not to beep for error messages and program terminations. @@ -136,7 +139,7 @@ MODULE NWTC_IO END INTERFACE !> \copydoc nwtc_io::parsechvarwdefault - INTERFACE ParseVarWDefault ! Parses a character variable name and value from a string, potentially sets to a default value if "Default" is parsed. + INTERFACE ParseVarWDefault ! Parses a boolean variable name and value from a string, potentially sets to a default value if "Default" is parsed. MODULE PROCEDURE ParseChVarWDefault ! Parses a character string from a string, potentially sets to a default value if "Default" is parsed. MODULE PROCEDURE ParseDbVarWDefault ! Parses a double-precision REAL from a string, potentially sets to a default value if "Default" is parsed. MODULE PROCEDURE ParseInVarWDefault ! Parses an INTEGER from a string, potentially sets to a default value if "Default" is parsed. @@ -152,6 +155,13 @@ MODULE NWTC_IO MODULE PROCEDURE ParseSiAry ! Parse an array of single-precision REAL values. END INTERFACE + !> \copydoc nwtc_io::checkr4var + INTERFACE CheckRealVar + MODULE PROCEDURE CheckR4Var ! 4-byte real + MODULE PROCEDURE CheckR8Var ! 8-byte real + MODULE PROCEDURE CheckR16Var ! 16-byte real + END INTERFACE + !> \copydoc nwtc_io::readcvar INTERFACE ReadVar MODULE PROCEDURE ReadCVar @@ -166,7 +176,7 @@ MODULE NWTC_IO INTERFACE ReadVarWDefault !MODULE PROCEDURE ReadCVar MODULE PROCEDURE ReadIVarWDefault - !MODULE PROCEDURE ReadLVar + MODULE PROCEDURE ReadLVarWDefault ! Logical MODULE PROCEDURE ReadR4VarWDefault ! 4-byte real MODULE PROCEDURE ReadR8VarWDefault ! 8-byte real MODULE PROCEDURE ReadR16VarWDefault ! 16-byte real @@ -179,8 +189,11 @@ MODULE NWTC_IO MODULE PROCEDURE ReadIAry MODULE PROCEDURE ReadLAry MODULE PROCEDURE ReadR4Ary ! read array of 4-byte reals + MODULE PROCEDURE ReadR4AryFromStr MODULE PROCEDURE ReadR8Ary ! read array of 8-byte reals + MODULE PROCEDURE ReadR8AryFromStr MODULE PROCEDURE ReadR16Ary ! read array of 16-byte reals + MODULE PROCEDURE ReadR16AryFromStr END INTERFACE !> \copydoc nwtc_io::readcarylines @@ -1487,16 +1500,16 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) ! Local declarations: INTEGER :: I, J ! Iterator variables - CHARACTER(1024) :: Arg + CHARACTER(1024) :: Arg, FlagIter CHARACTER(1024), DIMENSION(:), ALLOCATABLE :: ArgArray, TempArray, Flags LOGICAL :: FirstArgumentSet, SecondArgumentSet FirstArgumentSet = .FALSE. SecondArgumentSet = .FALSE. - + IF ( PRESENT(Arg2) ) Arg2 = "" IF ( PRESENT(Flag) ) Flag = "" - + ! Save all arguments in a single argument array; this is primarily used to enable unit testing IF ( PRESENT(InputArgArray) ) THEN ALLOCATE( ArgArray( SIZE(InputArgArray) ) ) @@ -1544,13 +1557,24 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) DO I = 1, SIZE(Flags) - Flag = Flags(I)(2:) ! This results in the flag without the switch character - CALL Conv2UC( Flag ) + FlagIter = Flags(I)(2:) ! This results in the flag without the switch character + CALL Conv2UC( FlagIter ) + IF ( PRESENT(Flag) ) Flag = FlagIter - SELECT CASE ( TRIM(Flag) ) + SELECT CASE ( TRIM(FlagIter) ) CASE ('H') + CALL DispCopyrightLicense( ProgName ) + CALL DispCompileRuntimeInfo CALL NWTC_DisplaySyntax( Arg1, ProgName ) + IF ( PRESENT( ErrStat ) ) ErrStat = ErrID_None + CALL CLEANUP() + RETURN + + CASE ('V', 'VERSION') + CALL DispCopyrightLicense( ProgName ) + CALL DispCompileRuntimeInfo + IF ( PRESENT( ErrStat ) ) ErrStat = ErrID_None CALL CLEANUP() RETURN @@ -1562,14 +1586,25 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) IF ( .NOT. FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN CALL INVALID_SYNTAX( 'the restart capability requires at least one argument: -restart ' ) CALL CLEANUP() - RETURN + RETURN + END IF + + CASE ('VTKLIN') + IF ( FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN + Arg2 = Arg1 + Arg1 = "" + END IF + IF ( .NOT. FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN + CALL INVALID_SYNTAX( 'the restart capability for vtk mode shapes requires at least one argument: -vtklin ' ) + CALL CLEANUP() + RETURN END IF CASE DEFAULT - CALL INVALID_SYNTAX( 'unknown command-line argument given: '//TRIM(Flag) ) + CALL INVALID_SYNTAX( 'unknown command-line argument given: '//TRIM(FlagIter) ) CALL CLEANUP() RETURN - + END SELECT END DO @@ -1577,7 +1612,7 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) IF ( PRESENT( ErrStat ) ) ErrStat = ErrID_None CALL CLEANUP() - RETURN + RETURN CONTAINS SUBROUTINE CLEANUP() @@ -1590,12 +1625,11 @@ SUBROUTINE INVALID_SYNTAX(ErrorMessage) CHARACTER(*), INTENT(IN) :: ErrorMessage + CALL DispCopyrightLicense( ProgName ) + CALL DispCompileRuntimeInfo CALL NWTC_DisplaySyntax( Arg1, ProgName ) CALL ProgAbort( ' Invalid syntax: '//TRIM(ErrorMessage), PRESENT(ErrStat) ) - IF ( PRESENT(ErrStat) ) THEN - ErrStat = ErrID_Fatal - RETURN - END IF + IF ( PRESENT(ErrStat) ) ErrStat = ErrID_Fatal END SUBROUTINE @@ -1742,7 +1776,7 @@ SUBROUTINE ChkRealFmtStr ( RealFmt, RealFmtVar, FmtWidth, ErrStat, ErrMsg ) REAL, PARAMETER :: TestVal = -1.0 ! The value to test the format specifier with. INTEGER :: IOS ! An integer to store the I/O status of the attempted internal write. - INTEGER, PARAMETER :: TestStrLen = 20 ! A parameter for specifying the length of RealStr. + INTEGER, PARAMETER :: TestStrLen = 30 ! A parameter for specifying the length of RealStr. CHARACTER(TestStrLen) :: RealStr ! A string to test writing a real number to. @@ -1849,6 +1883,60 @@ SUBROUTINE CheckIOS ( IOS, Fil, Variable, VarType, ErrStat, ErrMsg, TrapErrors ) RETURN END SUBROUTINE CheckIOS !======================================================================= +!> This routine checks that real values are finite and not NaNs +SUBROUTINE CheckR4Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(SiKi), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR4Var +!======================================================================= +!> \copydoc nwtc_io::checkr4var +SUBROUTINE CheckR8Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(R8Ki), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR8Var +!======================================================================= +!> \copydoc nwtc_io::checkr4var +SUBROUTINE CheckR16Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(QuKi), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR16Var +!======================================================================= !> This routine converts all the text in a string to upper case. SUBROUTINE Conv2UC ( Str ) @@ -2016,38 +2104,28 @@ FUNCTION CurTime( ) END FUNCTION CurTime !======================================================================= !> This routine displays some text about copyright and license. - SUBROUTINE DispCopyrightLicense( ProgInfo, AdditionalComment ) + SUBROUTINE DispCopyrightLicense( ProgramName, AdditionalComment ) - - TYPE( ProgDesc ), INTENT(IN) :: ProgInfo !< Contains the name and version info of the program being run + CHARACTER(*), INTENT(IN) :: ProgramName !< The name of the program being run CHARACTER(*), INTENT(IN), OPTIONAL :: AdditionalComment !< An additional comment displayed in the copyright notice. Typically used to describe alpha versions or one-off versions. ! local variable - INTEGER(IntKi) :: DateLen ! the trim length of the ProgInfo date field INTEGER(IntKi) :: I ! generic loop/index - CHARACTER(4) :: year ! the year, determined from ProgInfo's date field + CHARACTER(4) :: Year ! the year, determined from the FPP __DATE__ variable CHARACTER(MaxWrScrLen) :: Stars ! a line of '*******' characters DO I=1,MaxWrScrLen Stars(I:I)='*' END DO - - DateLen = LEN_TRIM(ProgInfo%date) - IF ( DateLen > 3 ) THEN - I = DateLen-4+1 - year = ProgInfo%date(I:) - ELSE - year = '' - END IF - + Year = __DATE__(8:11) CALL WrScr('') CALL WrScr(Stars) - CALL WrScr( TRIM(GetNVD(ProgInfo)) ) + CALL WrScr( TRIM(ProgramName) ) CALL WrScr('') - CALL WrScr( 'Copyright (C) '//TRIM(year)//' National Renewable Energy Laboratory' ) - CALL WrScr( 'Copyright (C) '//TRIM(year)//' Envision Energy USA LTD' ) + CALL WrScr( 'Copyright (C) '//TRIM(Year)//' National Renewable Energy Laboratory' ) + CALL WrScr( 'Copyright (C) '//TRIM(Year)//' Envision Energy USA LTD' ) CALL WrScr('') CALL WrScr( 'This program is licensed under Apache License Version 2.0 and comes with ABSOLUTELY NO WARRANTY. '//& 'See the "LICENSE" file distributed with this software for details.') @@ -2163,7 +2241,51 @@ SUBROUTINE DLLTypeUnPack( OutData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg ) END IF END SUBROUTINE DLLTypeUnPack +!======================================================================= +!> + SUBROUTINE DispCompileRuntimeInfo() +#ifdef HAS_FORTRAN2008_FEATURES + USE iso_fortran_env, ONLY: compiler_version +#endif + CHARACTER(200) :: compiler_version_str + CHARACTER(200) :: name + CHARACTER(200) :: git_commit, architecture, compiled_precision + CHARACTER(200) :: execution_date, execution_time, execution_zone + + name = ProgName + git_commit = QueryGitVersion() + architecture = TRIM(Num2LStr(BITS_IN_ADDR))//' bit' + IF (ReKi == SiKi) THEN + compiled_precision = 'single' + ELSE IF (ReKi == R8Ki) THEN + compiled_precision = 'double' + ELSE + compiled_precision = 'unknown' + END IF + +#if defined(HAS_FORTRAN2008_FEATURES) + compiler_version_str = compiler_version() +#elif defined(__INTEL_COMPILER) + compiler_version_str = 'Intel(R) Fortran Compiler '//num2lstr(__INTEL_COMPILER) +#endif + CALL WrScr(trim(name)//'-'//trim(git_commit)) + CALL WrScr('Compile Info:') + call wrscr(' - Compiler: '//trim(compiler_version_str)) + CALL WrScr(' - Architecture: '//trim(architecture)) + CALL WrScr(' - Precision: '//trim(compiled_precision)) + CALL WrScr(' - Date: '//__DATE__) + CALL WrScr(' - Time: '//__TIME__) + ! call wrscr(' - Options: '//trim(compiler_options())) + + CALL DATE_AND_TIME(execution_date, execution_time, execution_zone) + + CALL WrScr('Execution Info:') + CALL WrScr(' - Date: '//TRIM(execution_date(5:6)//'/'//execution_date(7:8)//'/'//execution_date(1:4))) + CALL WrScr(' - Time: '//TRIM(execution_time(1:2)//':'//execution_time(3:4)//':'//execution_time(5:6))//TRIM(execution_zone)) + CALL WrScr('') + + END SUBROUTINE !======================================================================= !> This routine displays the name of the program, its version, and its release date. !! Use DispNVD (nwtc_io::dispnvd) instead of directly calling a specific routine in the generic interface. @@ -2354,9 +2476,8 @@ FUNCTION GetErrStr ( ErrID ) END FUNCTION GetErrStr !======================================================================= -!> This function converts the three strings contained in the ProgDesc -!! data type into a single string listing the program name, -!! version, and release date. +!> This function extracts the Name field from the ProgDesc data type +! and return it. FUNCTION GetNVD ( ProgInfo ) ! Argument declarations. @@ -2372,12 +2493,13 @@ END FUNCTION GetNVD !======================================================================= !> Let's parse the path name from the name of the given file. !! We'll count everything before (and including) the last "\" or "/". - SUBROUTINE GetPath ( GivenFil, PathName ) + SUBROUTINE GetPath ( GivenFil, PathName, FileName ) ! Argument declarations. - CHARACTER(*), INTENT(IN) :: GivenFil !< The name of the given file. - CHARACTER(*), INTENT(OUT) :: PathName !< The path name of the given file (based solely on the GivenFil text string). + CHARACTER(*), INTENT(IN) :: GivenFil !< The name of the given file. + CHARACTER(*), INTENT(OUT) :: PathName !< The path name of the given file (based solely on the GivenFil text string). + CHARACTER(*), INTENT(OUT), OPTIONAL :: FileName !< The name of the given file without the PathName (based solely on the GivenFil text string). ! Local declarations. @@ -2393,8 +2515,16 @@ SUBROUTINE GetPath ( GivenFil, PathName ) IF ( I == 0 ) THEN ! we don't have a path specified, return '.' PathName = '.'//PathSep + IF (PRESENT(FileName)) FileName = GivenFil ELSE PathName = GivenFil(:I) + IF (PRESENT(FileName)) THEN + IF ( LEN_TRIM(GivenFil) > I ) THEN + FileName = GivenFil(I+1:) + ELSE + FileName = "" + END IF + END IF END IF @@ -2636,6 +2766,22 @@ FUNCTION Int2LStr ( Num ) RETURN END FUNCTION Int2LStr !======================================================================= +!> This function returns true if and only if the first character of the input StringToCheck matches on the of comment characters +!! nwtc_io::commchars. + FUNCTION IsComment(StringToCheck) + ! Note: only the first character in the word is checked. Otherwise we would falsely grab the units '(%)' + LOGICAL :: IsComment + CHARACTER(*), INTENT(IN ) :: StringToCheck ! String to check + + + if ( LEN_TRIM(StringToCheck) > 0 ) then + ISComment = INDEX( CommChars, StringToCheck(1:1) ) > 0 + else + IsComment = .FALSE. + end if + + END FUNCTION IsComment +!======================================================================= !> This routine gets the name of the input file from the InArgth command-line argument, !! removes the extension if there is one, and appends OutExten to the end. SUBROUTINE NameOFile ( InArg, OutExten, OutFile, ErrStat, ErrMsg ) @@ -3036,6 +3182,7 @@ SUBROUTINE OpenFUnkFileAppend ( Un, OutFile, ErrStat, ErrMsg ) RETURN END SUBROUTINE OpenFUnkFileAppend ! ( Un, OutFile [, ErrStat] [, ErrMsg] ) +!======================================================================= !> This routine opens an unformatted input file of RecLen-byte data records !! stored in Big Endian format. SUBROUTINE OpenUInBEFile( Un, InFile, RecLen, ErrStat, ErrMsg ) @@ -3313,8 +3460,8 @@ SUBROUTINE ParseDbAry ( 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(20), ALLOCATABLE :: Words (:) ! The array "words" parsed from the line. CHARACTER(*), PARAMETER :: RoutineName = 'ParseDbAry' @@ -3329,14 +3476,6 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg END IF - ALLOCATE ( Words( AryLen ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the Words array.',ErrStat,ErrMsg,RoutineName ) - CALL Cleanup() - RETURN - ENDIF - - READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStatLcl) Ary IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'A fatal error occurred when parsing data from "' & @@ -3345,34 +3484,22 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"',ErrStat,ErrMsg,RoutineName ) RETURN - CALL Cleanup() ENDIF + + DO i=1,AryLen + call CheckRealVar( Ary(i), AryName, ErrStat, ErrMsg ) + if (ErrStat>= AbortErrLev) return + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(A)') TRIM( FileInfo%Lines(LineNum) ) END IF LineNum = LineNum + 1 - CALL Cleanup() RETURN - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE Cleanup ( ) - - ! This subroutine cleans up the parent routine before exiting. - - ! Deallocate the Words array if it had been allocated. - - IF ( ALLOCATED( Words ) ) DEALLOCATE( Words ) - - - RETURN - - END SUBROUTINE Cleanup - END SUBROUTINE ParseDbAry !======================================================================= !> \copydoc nwtc_io::parsechvar @@ -3430,7 +3557,9 @@ SUBROUTINE ParseDbVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE NewLine//' "'//TRIM( FileInfo%Lines(LineNum) )//'"', ErrStat, ErrMsg, RoutineName) RETURN ENDIF - + CALL CheckRealVar( Var, ExpVarName, ErrStatLcl, ErrMsg2) + CALL SetErrStat(ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words END IF @@ -4042,8 +4171,8 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ! Local declarations. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. + INTEGER(IntKi) :: i - CHARACTER(20), ALLOCATABLE :: Words (:) ! The array "words" parsed from the line. CHARACTER(*), PARAMETER :: RoutineName = 'ParseSiAry' ErrStat = ErrID_None @@ -4056,14 +4185,6 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg RETURN END IF - ALLOCATE ( Words( AryLen ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the Words array.', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - ENDIF - - READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStatLcl) Ary IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data from "' & @@ -4071,7 +4192,6 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ' >> The "'//TRIM( AryName )//'" array was not assigned valid REAL values on line #' & //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() RETURN ENDIF @@ -4079,27 +4199,15 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF ( UnEc > 0 ) WRITE (UnEc,'(A)') TRIM( FileInfo%Lines(LineNum) ) END IF + DO i=1,AryLen + call CheckRealVar( Ary(i), AryName, ErrStat, ErrMsg ) + if (ErrStat>= AbortErrLev) return + END DO + LineNum = LineNum + 1 - CALL Cleanup ( ) - RETURN - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE Cleanup ( ) - - ! This subroutine cleans up the parent routine before exiting. - - ! Deallocate the Words array if it had been allocated. - - IF ( ALLOCATED( Words ) ) DEALLOCATE( Words ) - - RETURN - - END SUBROUTINE Cleanup - END SUBROUTINE ParseSiAry !======================================================================= !> \copydoc nwtc_io::parsechvar @@ -4157,6 +4265,8 @@ SUBROUTINE ParseSiVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE RETURN ENDIF + CALL CheckRealVar( Var, ExpVarName, ErrStat, ErrMsg) + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words END IF @@ -4996,14 +5106,14 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) ! Argument declarations. - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< An optional error level to be returned to the calling routine. - INTEGER(IntKi), INTENT(INOUT) :: UnIn !< The IO unit for the FAST binary file. + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< An optional error level to be returned to the calling routine. + INTEGER(IntKi), INTENT(INOUT) :: UnIn !< The IO unit for the FAST binary file. - LOGICAL, INTENT(IN) :: Init !< A flag to tell the routine to read only the file header for initialization purposes. + LOGICAL, INTENT(IN) :: Init !< A flag to tell the routine to read only the file header for initialization purposes. - CHARACTER(*), INTENT( OUT) :: ErrMsg !< An optional error message to be returned to the calling routine. + CHARACTER(*), INTENT( OUT) :: ErrMsg !< An optional error message to be returned to the calling routine. - TYPE (FASTdataType), INTENT(INOUT) :: FASTdata !< The derived type for holding FAST output data. + TYPE (FASTdataType), INTENT(INOUT) :: FASTdata !< The derived type for holding FAST output data. ! Local declarations. @@ -5024,17 +5134,18 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: IRow ! The row index used for DO loops. INTEGER(IntKi) :: LenDesc ! The length of the description string, DescStr. INTEGER(IntKi), PARAMETER :: MaxLenDesc = 1024 ! The maximum allowed length of the description string, DescStr. - INTEGER(IntKi), PARAMETER :: MaxChrLen = 10 ! The maximum length for channel names and units. - + INTEGER(IntKi) :: ChanLen2 ! The lengths of channel names in the file + INTEGER(B4Ki), ALLOCATABLE :: TmpTimeArray(:) ! This array holds the normalized time channel that was read from the binary file. INTEGER(B4Ki) :: Tmp4BInt ! This scalar temporarially holds a 4-byte integer that was stored in the binary file INTEGER(B2Ki) :: FileType ! The type of FAST data file (1: Time channel included in file; 2: Time stored as start time and step). + INTEGER(B2Ki) :: Tmp2BInt ! This scalar temporarially holds a 2-byte integer that was stored in the binary file. INTEGER(B2Ki), ALLOCATABLE :: TmpInArray(:,:) ! This array holds the normalized channels that were read from the binary file. INTEGER(R8Ki), ALLOCATABLE :: TmpR8InArray(:,:) ! This array holds the uncompressed channels that were read from the binary file. INTEGER(B1Ki), ALLOCATABLE :: DescStrASCII(:) ! The ASCII equivalent of DescStr. - INTEGER(B1Ki) :: TmpStrASCII(MaxChrLen) ! The temporary ASCII equivalent of a channel name or units. + INTEGER(B1Ki), ALLOCATABLE :: TmpStrASCII(:) ! The temporary ASCII equivalent of a channel name or units. INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5072,6 +5183,19 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF + + IF (FileType == FileFmtID_ChanLen_In) THEN + READ (UnIn, IOSTAT=ErrStat2) Tmp2BInt + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading ChanLen from file "'//TRIM( FASTdata%File )//'".', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF + ChanLen2 = Tmp2BInt + ELSE + ChanLen2 = 10 + END IF + READ (UnIn, IOSTAT=ErrStat2) Tmp4BInt IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading the number of channels from file "' & @@ -5265,6 +5389,13 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) FASTdata%Descr(IChr:IChr) = CHAR( DescStrASCII(IChr) ) END DO + + ALLOCATE ( TmpStrASCII( ChanLen2 ) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the DescStrASCII array.', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF TmpStrASCII(:) = ICHAR( ' ' ) DO IChan=1,FASTdata%NumChans+1 READ (UnIn, IOSTAT=ErrStat2) TmpStrASCII @@ -5275,7 +5406,7 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF FASTdata%ChanNames(IChan) = '' - DO IChr=1,MaxChrLen + DO IChr=1,ChanLen2 FASTdata%ChanNames(IChan)(IChr:IChr) = CHAR( TmpStrASCII(IChr) ) END DO END DO @@ -5290,7 +5421,7 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF FASTdata%ChanUnits(IChan) = '' - DO IChr=1,MaxChrLen + DO IChr=1,ChanLen2 FASTdata%ChanUnits(IChan)(IChr:IChr) = CHAR( TmpStrASCII(IChr) ) END DO END DO @@ -5347,15 +5478,17 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) END DO ! IRow=1,FASTdata%NumRecs - DO IRow=1,FASTdata%NumRecs - IF ( FileType == FileFmtID_NoCompressWithoutTime ) THEN + IF ( FileType == FileFmtID_NoCompressWithoutTime ) THEN + DO IRow=1,FASTdata%NumRecs FASTdata%Data(IRow,2:) = REAL(TmpInArray(IRow,:), ReKi) - ELSE + END DO ! IRow=1,FASTdata%NumRecs + ELSE + DO IRow=1,FASTdata%NumRecs ! Denormalize the data one row at a time and store it in the FASTdata%Data array. FASTdata%Data(IRow,2:) = ( TmpInArray(IRow,:) - ColOff(:) )/ColScl(:) - END IF + END DO ! IRow=1,FASTdata%NumRecs + END IF - END DO ! IRow=1,FASTdata%NumRecs CALL Cleanup( ) @@ -5376,6 +5509,7 @@ SUBROUTINE Cleanup ( ) IF ( ALLOCATED( ColOff ) ) DEALLOCATE( ColOff ) IF ( ALLOCATED( ColScl ) ) DEALLOCATE( ColScl ) IF ( ALLOCATED( DescStrASCII ) ) DEALLOCATE( DescStrASCII ) + IF ( ALLOCATED( TmpStrASCII ) ) DEALLOCATE( TmpStrASCII ) IF ( ALLOCATED( TmpInArray ) ) DEALLOCATE( TmpInArray ) IF ( ALLOCATED( TmpR8InArray ) ) DEALLOCATE( TmpR8InArray ) IF ( ALLOCATED( TmpTimeArray ) ) DEALLOCATE( TmpTimeArray ) @@ -5528,6 +5662,56 @@ SUBROUTINE ReadIVarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Err RETURN END SUBROUTINE ReadIVarWDefault !======================================================================= +!> This routine reads a logical variable from the next line of the input file. +!! Use ReadVarWDefault (nwtc_io::readvarwdefault) instead of directly calling a specific routine in the generic interface. +!! WARNING: this routine limits the size of the number being read to 30 characters + SUBROUTINE ReadLVarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, ErrStat, ErrMsg, UnEc ) + + ! Argument declarations: + + LOGICAL, INTENT(OUT) :: Var !< variable being read + LOGICAL, INTENT(IN) :: VarDefault !< default value of variable being read + INTEGER, INTENT(IN) :: UnIn !< I/O unit for input file. + INTEGER, INTENT(IN), OPTIONAL:: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status; if present, program does not abort on error + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + + CHARACTER(*), INTENT(IN) :: Fil !< Name of the input file. + CHARACTER(*), INTENT(IN) :: VarDescr !< Text string describing the variable. + CHARACTER(*), INTENT(IN) :: VarName !< Text string containing the variable name. + + + ! Local declarations: + + INTEGER :: IOS ! I/O status returned from the read statement. + + CHARACTER(30) :: Word ! String to hold the first word on the line. + + + CALL ReadNum ( UnIn, Fil, Word, VarName, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN ! If we're about to read a T/F and treat it as a number, we have a less severe ErrStat + + CALL Conv2UC( Word ) + IF ( INDEX(Word, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the DEFAULT value + READ (Word,*,IOSTAT=IOS) Var + + CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) + + IF (ErrStat >= AbortErrLev) RETURN + ELSE + Var = VarDefault + END IF + + IF ( PRESENT(UnEc) ) THEN + IF ( UnEc > 0 ) & + WRITE (UnEc,Ec_IntFrmt) Var, VarName, VarDescr + END IF + + + RETURN + END SUBROUTINE ReadLVarWDefault +!======================================================================= + !> \copydoc nwtc_io::readcary SUBROUTINE ReadLAry ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) @@ -5574,7 +5758,7 @@ END SUBROUTINE ReadLAry !============================================================================= !> This routine reads a line from the specified input file and returns the non-comment !! portion of the line. - SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) + SUBROUTINE ReadLine ( UnIn, CommentChars, Line, LineLen, IOStat ) ! Argument declarations. @@ -5583,7 +5767,7 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) INTEGER, INTENT(IN) :: UnIn !< The unit number for the file being read. INTEGER, INTENT(OUT) :: LineLen !< The length of the line returned from ReadLine(). - CHARACTER(*), INTENT(IN) :: CommChars !< The list of possible comment characters. + CHARACTER(*), INTENT(IN) :: CommentChars !< The list of possible comment characters. CHARACTER(*), INTENT(OUT) :: Line !< The decommented line being returned to the calling routine. ! Local declarations. @@ -5591,7 +5775,7 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) INTEGER :: CommLoc ! The left-most location of a given comment character in the Line. INTEGER :: FirstComm ! The location of first comment character in the Line. INTEGER :: IC ! The index for the character location in the string. - INTEGER :: NumCommChars ! The number of comment characters in the CommChars array. + INTEGER :: NumCommChars ! The number of comment characters in the CommentChars array. READ (UnIn,'(A)',IOSTAT=IOStat) Line @@ -5603,14 +5787,14 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) ENDIF LineLen = LEN_TRIM( Line ) - NumCommChars = LEN_TRIM( CommChars ) + NumCommChars = LEN_TRIM( CommentChars ) IF ( ( NumCommChars == 0 ) .OR. ( LineLen == 0 ) ) RETURN FirstComm = MIN( LEN( Line ), LineLen + 1 ) DO IC=1,NumCommChars - CommLoc = INDEX( Line, CommChars(IC:IC) ) + CommLoc = INDEX( Line, CommentChars(IC:IC) ) IF ( CommLoc > 0 ) THEN FirstComm = MIN( CommLoc, FirstComm ) ENDIF @@ -5822,8 +6006,12 @@ SUBROUTINE ReadR4Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs READ (UnIn,*,IOSTAT=IOS) ( Ary(Ind), Ind=1,AryLen ) CALL CheckIOS ( IOS, Fil, TRIM( AryName ), NumType, ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN - IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN @@ -5834,6 +6022,50 @@ SUBROUTINE ReadR4Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs RETURN END SUBROUTINE ReadR4Ary +!====================================================================== +!> This routine reads a AryLen values separated by whitespace (or other Fortran record delimiters such as commas) +!! into an array (either on same line or multiple lines) from an input string +!! Use ReadAry (nwtc_io::readary) instead of directly calling a specific routine in the generic interface. + SUBROUTINE ReadR4AryFromStr ( Str, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) + + ! Argument declarations: + CHARACTER(*), INTENT(IN) :: Str !< String to read from + INTEGER, INTENT(IN) :: AryLen !< Length of the array. + INTEGER, INTENT(IN), OPTIONAL:: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message describing ErrStat + REAL(SiKi), INTENT(INOUT) :: Ary(AryLen) ! Real array being read. + CHARACTER(*), INTENT(IN) :: AryDescr !< Text string describing the variable. + CHARACTER(*), INTENT(IN) :: AryName !< Text string containing the variable name. + ! Local declarations: + INTEGER :: Ind ! Index into the string array. Assumed to be one digit. + INTEGER :: IOS ! I/O status returned from the read statement. + + ! Init of output + do Ind=1,AryLen + Ary(Ind)=0.0 + end do + ! Reading fields from string + READ (Str,*,IOSTAT=IOS) ( Ary(Ind), Ind=1,AryLen ) + + ! Dedicated "CheckIOS" + IF ( IOS < 0 ) THEN + write(ErrMsg,'(A,I0,A)') 'End of line reached while trying to read ',AryLen,' value from string:`'//trim(Str)//'`' + ErrStat = ErrID_Fatal + ELSE IF ( IOS > 0 ) THEN + write(ErrMsg,'(A,I0,A)') 'Unexpected error while trying to read ',AryLen,' value from string:`'//trim(Str)//'`' + ELSE + ErrMsg='' + ErrStat = ErrID_None + END IF + IF (ErrStat >= AbortErrLev) RETURN + IF ( PRESENT(UnEc) ) THEN + IF ( UnEc > 0 ) & + WRITE (UnEc,Ec_ReAryFrmt) TRIM( AryName ), AryDescr, ( Ary(Ind), Ind=1,MIN(AryLen,NWTC_MaxAryLen) ) + END IF + RETURN + END SUBROUTINE ReadR4AryFromStr +!======================================================================= !======================================================================= !> \copydoc nwtc_io::readcary SUBROUTINE ReadR8Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) @@ -5872,6 +6104,11 @@ SUBROUTINE ReadR8Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN WRITE( UnEc, Ec_ReAryFrmt ) TRIM( AryName ), AryDescr, Ary(1:MIN(AryLen,NWTC_MaxAryLen)) @@ -5880,6 +6117,49 @@ SUBROUTINE ReadR8Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs RETURN END SUBROUTINE ReadR8Ary +!====================================================================== +!> This routine reads a AryLen values separated by whitespace (or other Fortran record delimiters such as commas) +!! into an array (either on same line or multiple lines) from an input string +!! Use ReadAry (nwtc_io::readary) instead of directly calling a specific routine in the generic interface. + SUBROUTINE ReadR8AryFromStr ( Str, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) + + ! Argument declarations: + CHARACTER(*), INTENT(IN) :: Str !< String to read from + INTEGER, INTENT(IN) :: AryLen !< Length of the array. + INTEGER, INTENT(IN), OPTIONAL:: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message describing ErrStat + REAL(R8Ki), INTENT(INOUT) :: Ary(AryLen) ! Real array being read. + CHARACTER(*), INTENT(IN) :: AryDescr !< Text string describing the variable. + CHARACTER(*), INTENT(IN) :: AryName !< Text string containing the variable name. + ! Local declarations: + INTEGER :: Ind ! Index into the string array. Assumed to be one digit. + INTEGER :: IOS ! I/O status returned from the read statement. + + ! Init of output + do Ind=1,AryLen + Ary(Ind)=0.0 + end do + ! Reading fields from string + READ (Str,*,IOSTAT=IOS) ( Ary(Ind), Ind=1,AryLen ) + + ! Dedicated "CheckIOS" + IF ( IOS < 0 ) THEN + write(ErrMsg,'(A,I0,A)') 'End of line reached while trying to read ',AryLen,' value from string:`'//trim(Str)//'`' + ErrStat = ErrID_Fatal + ELSE IF ( IOS > 0 ) THEN + write(ErrMsg,'(A,I0,A)') 'Unexpected error while trying to read ',AryLen,' value from string:`'//trim(Str)//'`' + ELSE + ErrMsg='' + ErrStat = ErrID_None + END IF + IF (ErrStat >= AbortErrLev) RETURN + IF ( PRESENT(UnEc) ) THEN + IF ( UnEc > 0 ) & + WRITE (UnEc,Ec_ReAryFrmt) TRIM( AryName ), AryDescr, ( Ary(Ind), Ind=1,MIN(AryLen,NWTC_MaxAryLen) ) + END IF + RETURN + END SUBROUTINE ReadR8AryFromStr !======================================================================= !> \copydoc nwtc_io::readcary SUBROUTINE ReadR16Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) @@ -5918,6 +6198,11 @@ SUBROUTINE ReadR16Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrM IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN WRITE( UnEc, Ec_ReAryFrmt ) TRIM( AryName ), AryDescr, Ary(1:MIN(AryLen,NWTC_MaxAryLen)) @@ -5927,6 +6212,49 @@ SUBROUTINE ReadR16Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrM RETURN END SUBROUTINE ReadR16Ary +!====================================================================== +!> This routine reads a AryLen values separated by whitespace (or other Fortran record delimiters such as commas) +!! into an array (either on same line or multiple lines) from an input string +!! Use ReadAry (nwtc_io::readary) instead of directly calling a specific routine in the generic interface. + SUBROUTINE ReadR16AryFromStr ( Str, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) + + ! Argument declarations: + CHARACTER(*), INTENT(IN) :: Str !< String to read from + INTEGER, INTENT(IN) :: AryLen !< Length of the array. + INTEGER, INTENT(IN), OPTIONAL:: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message describing ErrStat + REAL(QuKi), INTENT(INOUT) :: Ary(AryLen) ! Real array being read. + CHARACTER(*), INTENT(IN) :: AryDescr !< Text string describing the variable. + CHARACTER(*), INTENT(IN) :: AryName !< Text string containing the variable name. + ! Local declarations: + INTEGER :: Ind ! Index into the string array. Assumed to be one digit. + INTEGER :: IOS ! I/O status returned from the read statement. + + ! Init of output + do Ind=1,AryLen + Ary(Ind)=0.0 + end do + ! Reading fields from string + READ (Str,*,IOSTAT=IOS) ( Ary(Ind), Ind=1,AryLen ) + + ! Dedicated "CheckIOS" + IF ( IOS < 0 ) THEN + write(ErrMsg,'(A,I0,A)') 'End of line reached while trying to read ',AryLen,' value from string:`'//trim(Str)//'`' + ErrStat = ErrID_Fatal + ELSE IF ( IOS > 0 ) THEN + write(ErrMsg,'(A,I0,A)') 'Unexpected error while trying to read ',AryLen,' value from string:`'//trim(Str)//'`' + ELSE + ErrMsg='' + ErrStat = ErrID_None + END IF + IF (ErrStat >= AbortErrLev) RETURN + IF ( PRESENT(UnEc) ) THEN + IF ( UnEc > 0 ) & + WRITE (UnEc,Ec_ReAryFrmt) TRIM( AryName ), AryDescr, ( Ary(Ind), Ind=1,MIN(AryLen,NWTC_MaxAryLen) ) + END IF + RETURN + END SUBROUTINE ReadR16AryFromStr !======================================================================= !> \copydoc nwtc_io::readcarylines SUBROUTINE ReadR4AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) @@ -5960,8 +6288,9 @@ SUBROUTINE ReadR4AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6008,8 +6337,9 @@ SUBROUTINE ReadR8AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6056,8 +6386,9 @@ SUBROUTINE ReadR16AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6105,8 +6436,9 @@ SUBROUTINE ReadR4Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN @@ -6151,8 +6483,9 @@ SUBROUTINE ReadR4VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Er READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6198,9 +6531,9 @@ SUBROUTINE ReadR8Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6245,8 +6578,9 @@ SUBROUTINE ReadR8VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Er READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6298,9 +6632,9 @@ SUBROUTINE ReadR16Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6345,8 +6679,9 @@ SUBROUTINE ReadR16VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, E READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6448,8 +6783,6 @@ RECURSIVE SUBROUTINE ScanComFile ( FirstFile, ThisFile, LastFile, StartLine, Las LOGICAL :: FileFound ! A flag that is set to TRUE if this file has already been read. LOGICAL :: IsOpen ! A flag that is set to TRUE if this file is already open. -! Should the comment characters be passed to this routine instead of being hard coded? -mlb - CHARACTER(3), PARAMETER :: CommChars = '!#%' ! Comment characters that mark the end of useful input. CHARACTER(1024) :: FileName ! The name of this file being processed. CHARACTER(1024) :: IncFileName ! The name of a file that this one includes. CHARACTER(512) :: Line ! The contents of a line returned from ReadLine() with comment removed. @@ -6711,9 +7044,6 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al IMPLICIT NONE - INTEGER(IntKi), PARAMETER :: LenName = ChanLen ! Number of characters allowed in a channel name - INTEGER(IntKi), PARAMETER :: LenUnit = ChanLen ! Number of characters allowed in a channel unit - ! Passed data (sorted by element size, then alphabetical) REAL(DbKi), INTENT(IN) :: TimeData(:) !< The time being output to the file (if using FileFmtID_WithoutTime: element 1 is the first output time, element 2 is the delta t) @@ -6721,8 +7051,8 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(IntKi), INTENT(OUT):: ErrStat !< Indicates whether an error occurred (see NWTC_Library) INTEGER(B2Ki), INTENT(IN) :: FileID !< File ID, used to determine format of output file (use FileFmtID_WithTime or FileFmtID_WithoutTime) - CHARACTER(LenName),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) - CHARACTER(LenUnit),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) + CHARACTER(ChanLen),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) + CHARACTER(ChanLen),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) CHARACTER(*), INTENT(IN) :: DescStr !< Description to write to the binary file (e.g., program version, date, & time) CHARACTER(*), INTENT(OUT):: ErrMsg !< Error message associated with the ErrStat CHARACTER(*), INTENT(IN) :: FileName !< Name of the file to write the output in @@ -6770,6 +7100,8 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(B1Ki), ALLOCATABLE :: ChanNameASCII(:) ! The ASCII equivalent of ChanName INTEGER(B1Ki), ALLOCATABLE :: ChanUnitASCII(:) ! The ASCII equivalent of ChanUnit + INTEGER(IntKi) :: LenName ! Max number of characters in a channel name + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message CHARACTER(*), PARAMETER :: RoutineName = 'WrBinFAST' @@ -6803,11 +7135,20 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al !............................................................................................................................... ! Allocate arrays !............................................................................................................................... + IF (FileID==FileFmtID_ChanLen_In) THEN + LenName = 1 + DO IC = 1,NumOutChans+1 + LenName = MAX(LenName,LEN_TRIM(ChanName(IC))) + LenName = MAX(LenName,LEN_TRIM(ChanUnit(IC))) + END DO + ELSE + LenName = 10 + END IF CALL AllocAry( ChanNameASCII, (1+NumOutChans)*LenName , 'temporary channel name array (ChanNameASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( ChanUnitASCII, (1+NumOutChans)*LenUnit, 'temporary channel unit names (ChanUnitASCII)', ErrStat2, ErrMsg2 ) + CALL AllocAry( ChanUnitASCII, (1+NumOutChans)*LenName, 'temporary channel unit names (ChanUnitASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( DescStrASCII, LenDesc, 'temporary file description (DescStrASCII)', ErrStat2, ErrMsg2 ) @@ -6868,7 +7209,7 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al ! Channel units (ChanUnit) J = 1 DO IC = 1,SIZE(ChanUnit) - DO I=1,LenUnit + DO I=1,LenName ChanUnitASCII(J) = IACHAR( ChanUnit(IC)(I:I) ) J = J + 1 END DO @@ -6967,6 +7308,15 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al RETURN END IF + IF (FileID==FileFmtID_ChanLen_In) THEN + WRITE (UnIn, IOSTAT=ErrStat2) INT( LenName , B2Ki ) ! Length of channel names + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error writing ChanLen to the FAST binary file.', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup( ) + RETURN + END IF + END IF + WRITE (UnIn, IOSTAT=ErrStat2) INT( NumOutChans , B4Ki ) ! The number of output channels IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error writing NumOutChans to the FAST binary file.', ErrStat, ErrMsg, RoutineName ) @@ -7931,7 +8281,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(12:sz) - READ(Line,*) dims + READ(Line,*, IOSTAT=ErrStat2) dims + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "dims".', ErrStat, ErrMsg, RoutineName ) + end if END IF ! Origin @@ -7946,7 +8299,11 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(8:sz) - READ(Line,*) origin + READ(Line,*, IOSTAT=ErrStat2) origin + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "origin".', ErrStat, ErrMsg, RoutineName ) + end if + END IF ! Spacing @@ -7961,7 +8318,11 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(9:sz) - READ(Line,*) gridSpacing + READ(Line,*,IOSTAT=ErrStat2) gridSpacing + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "gridSpacing".', ErrStat, ErrMsg, RoutineName ) + end if + END IF ! Point Data @@ -7976,7 +8337,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(12:sz) - READ(Line,*) nPts + READ(Line,*,IOSTAT=ErrStat2) nPts + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "nPts".', ErrStat, ErrMsg, RoutineName ) + end if END IF ! Vector Label @@ -8011,23 +8375,24 @@ END SUBROUTINE ReadVTK_SP_info !> This routine reads the vector data for a vtk, ascii, structured_points dataset file, !! The Unit number of the file is already assumed to be valid via a previous call to !! ReadVTK_SP_info. - SUBROUTINE ReadVTK_SP_vectors( FileName, Un, dims, gridVals, ErrStat, ErrMsg ) + SUBROUTINE ReadVTK_SP_vectors( Un, dims, gridVals, ErrStat, ErrMsg ) - CHARACTER(*) , INTENT(IN ) :: FileName !< Name of output file INTEGER(IntKi) , INTENT(IN ) :: Un !< unit number of opened file INTEGER(IntKi) , INTENT(IN ) :: dims(3) !< dimension of the 3D grid (nX,nY,nZ) - REAL(ReKi) , INTENT( OUT) :: gridVals(:,:,:,:) !< 3D array of data, size (nX,nY,nZ), must be pre-allocated + REAL(ReKi) , INTENT( OUT) :: gridVals(:,:,:,:) !< 4D array of data, size (3,nX,nY,nZ), must be pre-allocated INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status of OpenFOutFile operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< message when error occurs INTEGER(IntKi) :: ErrStat2 ! local error level/status of OpenFOutFile operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local message when error occurs CHARACTER(*), PARAMETER :: RoutineName = 'ReadVTK_SP_vectors' ErrStat = ErrID_None ErrMsg = '' - READ(Un,*) gridVals(1:3,1:dims(1),1:dims(2),1:dims(3)) + READ(Un,*, IOSTAT=ErrStat2) gridVals(1:3,1:dims(1),1:dims(2),1:dims(3)) + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading vector data.', ErrStat, ErrMsg, RoutineName ) + end if close(Un) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index eb6d34fb0b..957edd0505 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -3,7 +3,7 @@ ! 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 !********************************************************************************************************************************* ! NWTC_Library_Types !................................................................................................................................. @@ -26,13 +26,20 @@ ! ! bjj: modifications made !********************************************************************************************************************************* -!> This module contains many of the user-defined types used in NWTC_Library. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry, but -!! was modified for the specific needs of NWTC Library. +!> This module contains the user-defined types needed in NWTC_Library. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SysSubs IMPLICIT NONE + + TYPE NWTC_RandomNumber_ParameterType + INTEGER(IntKi) :: pRNG + INTEGER(IntKi) :: RandSeed(3) ! The array that holds the initial random seeds for the 3 components. + INTEGER(IntKi), allocatable :: RandSeedAry(:) ! The array that holds the random seeds. + CHARACTER(6) :: RNG_type ! Type of Random Number Generator to use + END TYPE NWTC_RandomNumber_ParameterType + ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -60,14 +67,6 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= -! ========= OutParmFFType ======= - TYPE, PUBLIC :: OutParmFFType - INTEGER(IntKi) :: Indx !< An index into AllOuts array where this channel is computed/stored [-] - CHARACTER(ChanLenFF) :: Name !< Name of the output channel [-] - CHARACTER(ChanLenFF) :: Units !< Units this channel is specified in [-] - INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] - END TYPE OutParmFFType -! ======================= ! ========= FileInfoType ======= TYPE, PUBLIC :: FileInfoType INTEGER(IntKi) :: NumLines @@ -214,18 +213,18 @@ SUBROUTINE NWTC_Library_PackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Ver) - IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Date) - IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Ver) + IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Date) + IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE NWTC_Library_PackProgDesc SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -241,12 +240,6 @@ SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -262,18 +255,18 @@ SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Ver) - OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Date) - OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Ver) + OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Date) + OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE NWTC_Library_UnPackProgDesc SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -439,20 +432,20 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%File) - IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Descr) - IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumRecs - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimeStep - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%File) + IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Descr) + IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumChans + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumRecs + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeStep + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ChanNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -463,12 +456,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) + DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) DO I = 1, LEN(InData%ChanNames) IntKiBuf(Int_Xferred) = ICHAR(InData%ChanNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ChanUnits) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -480,12 +473,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanUnits,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) + DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) DO I = 1, LEN(InData%ChanUnits) IntKiBuf(Int_Xferred) = ICHAR(InData%ChanUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Data) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -500,8 +493,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Data)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Data))-1 ) = PACK(InData%Data,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Data) + DO i2 = LBOUND(InData%Data,2), UBOUND(InData%Data,2) + DO i1 = LBOUND(InData%Data,1), UBOUND(InData%Data,1) + ReKiBuf(Re_Xferred) = InData%Data(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_PackFASTdataType @@ -518,12 +515,6 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -539,20 +530,20 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%File) - OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Descr) - OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumChans = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumRecs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TimeStep = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%File) + OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Descr) + OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumChans = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumRecs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TimeStep = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -566,19 +557,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) + DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) DO I = 1, LEN(OutData%ChanNames) OutData%ChanNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanUnits not allocated Int_Xferred = Int_Xferred + 1 @@ -593,19 +577,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) + DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) DO I = 1, LEN(OutData%ChanUnits) OutData%ChanUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Data not allocated Int_Xferred = Int_Xferred + 1 @@ -623,15 +600,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Data)>0) OutData%Data = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Data))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Data) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Data,2), UBOUND(OutData%Data,2) + DO i1 = LBOUND(OutData%Data,1), UBOUND(OutData%Data,1) + OutData%Data(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_UnPackFASTdataType @@ -732,18 +706,18 @@ SUBROUTINE NWTC_Library_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SignM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Indx + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SignM + Int_Xferred = Int_Xferred + 1 END SUBROUTINE NWTC_Library_PackOutParmType SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -759,12 +733,6 @@ SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmType' @@ -778,177 +746,20 @@ SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Units) + OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SignM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE NWTC_Library_UnPackOutParmType - SUBROUTINE NWTC_Library_CopyOutParmFFType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OutParmFFType), INTENT(IN) :: SrcOutParmTypeData - TYPE(OutParmFFType), INTENT(INOUT) :: DstOutParmTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyOutParmFFType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM - END SUBROUTINE NWTC_Library_CopyOutParmFFType - - SUBROUTINE NWTC_Library_DestroyOutParmFFType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(OutParmFFType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmFFType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE NWTC_Library_DestroyOutParmFFType - - SUBROUTINE NWTC_Library_PackOutParmFFType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OutParmFFType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackOutParmFFType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! SignM - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SignM - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_PackOutParmFFType - - SUBROUTINE NWTC_Library_UnPackOutParmFFType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OutParmFFType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmFFType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_UnPackOutParmFFType - SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData @@ -1123,10 +934,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFiles - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumFiles + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FileLine) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1137,8 +948,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileLine,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FileLine)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FileLine))-1 ) = PACK(InData%FileLine,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FileLine) + DO i1 = LBOUND(InData%FileLine,1), UBOUND(InData%FileLine,1) + IntKiBuf(Int_Xferred) = InData%FileLine(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FileIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1150,8 +963,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FileIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FileIndx))-1 ) = PACK(InData%FileIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FileIndx) + DO i1 = LBOUND(InData%FileIndx,1), UBOUND(InData%FileIndx,1) + IntKiBuf(Int_Xferred) = InData%FileIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FileList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1163,12 +978,12 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) + DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) DO I = 1, LEN(InData%FileList) IntKiBuf(Int_Xferred) = ICHAR(InData%FileList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Lines) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1180,12 +995,12 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lines,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) + DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) DO I = 1, LEN(InData%Lines) IntKiBuf(Int_Xferred) = ICHAR(InData%Lines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE NWTC_Library_PackFileInfoType @@ -1202,12 +1017,6 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1222,10 +1031,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFiles = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumFiles = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileLine not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1239,15 +1048,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FileLine)>0) OutData%FileLine = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FileLine))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FileLine) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FileLine,1), UBOUND(OutData%FileLine,1) + OutData%FileLine(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileIndx not allocated Int_Xferred = Int_Xferred + 1 @@ -1262,15 +1066,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FileIndx)>0) OutData%FileIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FileIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FileIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FileIndx,1), UBOUND(OutData%FileIndx,1) + OutData%FileIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileList not allocated Int_Xferred = Int_Xferred + 1 @@ -1285,19 +1084,12 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) + DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) DO I = 1, LEN(OutData%FileList) OutData%FileList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lines not allocated Int_Xferred = Int_Xferred + 1 @@ -1312,19 +1104,12 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) + DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) DO I = 1, LEN(OutData%Lines) OutData%Lines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE NWTC_Library_UnPackFileInfoType @@ -1422,10 +1207,12 @@ SUBROUTINE NWTC_Library_PackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%v))-1 ) = PACK(InData%v,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%v) + ReKiBuf(Re_Xferred) = InData%q0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) + ReKiBuf(Re_Xferred) = InData%v(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_PackQuaternion SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1441,12 +1228,6 @@ SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1461,20 +1242,217 @@ SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%q0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%q0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%v,1) i1_u = UBOUND(OutData%v,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) + OutData%v(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE NWTC_Library_UnPackQuaternion + + SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: SrcNWTC_RandomNumber_ParameterTypeData + TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: DstNWTC_RandomNumber_ParameterTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG + DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed +IF (ALLOCATED(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN + i1_l = LBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) + i1_u = UBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) + IF (.NOT. ALLOCATED(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN + ALLOCATE(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry +ENDIF + DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type +END SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType + +SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg ) + 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' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN + DEALLOCATE(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) +ENDIF +END SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType + +SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' +! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! pRNG + Int_BufSz = Int_BufSz + SIZE(InData%RandSeed) ! RandSeed + Int_BufSz = Int_BufSz + 1 ! RandSeedAry allocated yes/no + IF ( ALLOCATED(InData%RandSeedAry) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RandSeedAry upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RandSeedAry) ! RandSeedAry + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%RNG_type) ! RNG_type + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - mask1 = .TRUE. - OutData%v = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%v))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%v) - DEALLOCATE(mask1) - END SUBROUTINE NWTC_Library_UnPackQuaternion + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%pRNG + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RandSeed,1), UBOUND(InData%RandSeed,1) + IntKiBuf(Int_Xferred) = InData%RandSeed(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%RandSeedAry) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RandSeedAry,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RandSeedAry,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RandSeedAry,1), UBOUND(InData%RandSeedAry,1) + IntKiBuf(Int_Xferred) = InData%RandSeedAry(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(InData%RNG_type) + IntKiBuf(Int_Xferred) = ICHAR(InData%RNG_type(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I +END SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType + +SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' +! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%pRNG = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%RandSeed,1) + i1_u = UBOUND(OutData%RandSeed,1) + DO i1 = LBOUND(OutData%RandSeed,1), UBOUND(OutData%RandSeed,1) + OutData%RandSeed(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RandSeedAry not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RandSeedAry)) DEALLOCATE(OutData%RandSeedAry) + ALLOCATE(OutData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RandSeedAry,1), UBOUND(OutData%RandSeedAry,1) + OutData%RandSeedAry(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%RNG_type) + OutData%RNG_type(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I +END SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 94e3c331a6..4c0803b8e3 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -55,6 +55,13 @@ MODULE NWTC_Num REAL(ReKi) :: TwoByPi !< 2/Pi REAL(ReKi) :: TwoPi !< 2*Pi + REAL(SiKi) :: Pi_R4 !< Ratio of a circle's circumference to its diameter in 4-byte precision + REAL(R8Ki) :: Pi_R8 !< Ratio of a circle's circumference to its diameter in 8-byte precision + REAL(QuKi) :: Pi_R16 !< Ratio of a circle's circumference to its diameter in 16-byte precision + + REAL(SiKi) :: TwoPi_R4 !< 2*pi in 4-byte precision + REAL(R8Ki) :: TwoPi_R8 !< 2*pi in 8-byte precision + REAL(QuKi) :: TwoPi_R16 !< 2*pi in 16-byte precision !======================================================================= ! Create interfaces for generic routines that use specific routines. @@ -109,10 +116,11 @@ MODULE NWTC_Num MODULE PROCEDURE GetSmllRotAngsR END INTERFACE - !> \copydoc nwtc_num::zero2twopir + !> \copydoc nwtc_num::zero2twopir4 INTERFACE Zero2TwoPi - MODULE PROCEDURE Zero2TwoPiD - MODULE PROCEDURE Zero2TwoPiR + MODULE PROCEDURE Zero2TwoPiR4 + MODULE PROCEDURE Zero2TwoPiR8 + MODULE PROCEDURE Zero2TwoPiR16 END INTERFACE !> \copydoc nwtc_num::twonormr4 @@ -172,6 +180,13 @@ MODULE NWTC_Num MODULE PROCEDURE InterpStpReal16 END INTERFACE + !> \copydoc nwtc_num::interparrayr4 + INTERFACE InterpArray + MODULE PROCEDURE InterpArrayR4 + MODULE PROCEDURE InterpArrayR8 + MODULE PROCEDURE InterpArrayR16 + END INTERFACE + !> \copydoc nwtc_num::interpwrappedstpreal4 INTERFACE InterpWrappedStpReal MODULE PROCEDURE InterpWrappedStpReal4 @@ -194,57 +209,131 @@ MODULE NWTC_Num MODULE PROCEDURE SkewSymMatR16 END INTERFACE + !> \copydoc nwtc_num::angle_extrapinterp2_r4 + INTERFACE Angles_ExtrapInterp + MODULE PROCEDURE Angles_ExtrapInterp1_R4 + MODULE PROCEDURE Angles_ExtrapInterp1_R8 + MODULE PROCEDURE Angles_ExtrapInterp1_R16 + MODULE PROCEDURE Angles_ExtrapInterp2_R4 + MODULE PROCEDURE Angles_ExtrapInterp2_R8 + MODULE PROCEDURE Angles_ExtrapInterp2_R16 + END INTERFACE + !> \copydoc nwtc_num::addorsub2pi_r4 + INTERFACE AddOrSub2Pi + MODULE PROCEDURE AddOrSub2Pi_R4 + MODULE PROCEDURE AddOrSub2Pi_R8 + MODULE PROCEDURE AddOrSub2Pi_R16 + END INTERFACE + + !> \copydoc nwtc_num::mpi2pi_r4 + INTERFACE MPi2Pi + MODULE PROCEDURE MPi2Pi_R4 + MODULE PROCEDURE MPi2Pi_R8 + MODULE PROCEDURE MPi2Pi_R16 + END INTERFACE + CONTAINS !======================================================================= -!> This routine is used to convert NewAngle to an angle within 2*Pi of -!! OldAngle by adding or subtracting 2*Pi accordingly; it then sets -!! OldAngle equal to NewAngle. This routine is useful for converting +!> This routine is used to convert NewAngle to an angle within Pi of +!! OldAngle by adding or subtracting 2*Pi accordingly. +!! This routine is useful for converting !! angles returned from a call to the ATAN2() FUNCTION into angles that may !! exceed the -Pi to Pi limit of ATAN2(). For example, if the nacelle yaw !! angle was 179deg in the previous time step and the yaw angle increased !! by 2deg in the new time step, we want the new yaw angle returned from a !! call to the ATAN2() FUNCTION to be 181deg instead of -179deg. This !! routine assumes that the angle change between calls is not more than -!! 2*Pi in absolute value. OldAngle should be saved in the calling -!! routine. - SUBROUTINE AddOrSub2Pi ( OldAngle, NewAngle ) +!! Pi in absolute value. +!! Use AddOrSub2Pi (nwtc_num::addorsub2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE AddOrSub2Pi_R4 ( OldAngle, NewAngle ) + ! Argument declarations: + + REAL(SiKi), INTENT(IN ) :: OldAngle !< Angle from which NewAngle will be converted to within Pi of, rad. + REAL(SiKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + + + ! Local declarations: + + REAL(SiKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) > Pi_R4 ) + + NewAngle = NewAngle + SIGN( TwoPi_R4, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO + + RETURN + END SUBROUTINE AddOrSub2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: OldAngle !< Angle from which NewAngle will be converted to within 2*Pi of, rad. - REAL(ReKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + REAL(R8Ki), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within Pi of, rad. + REAL(R8Ki), INTENT(INOUT) :: NewAngle ! Angle to be converted to within Pi of OldAngle, rad. ! Local declarations: - REAL(ReKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + REAL(R8Ki) :: DelAngle ! The difference between OldAngle and NewAngle, rad. - ! Add or subtract 2*Pi in order to convert NewAngle two within 2*Pi of - ! OldAngle: + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= TwoPi ) + DO WHILE ( ABS( DelAngle ) > Pi_R8 ) - NewAngle = NewAngle + SIGN( TwoPi, DelAngle ) + NewAngle = NewAngle + SIGN( TwoPi_R8, DelAngle ) DelAngle = OldAngle - NewAngle END DO + RETURN + END SUBROUTINE AddOrSub2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R16 ( OldAngle, NewAngle ) - ! Set OldAngle to equal NewAngle: + ! Argument declarations: - OldAngle = NewAngle + REAL(QuKi), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within 2*Pi of, rad. + REAL(QuKi), INTENT(INOUT) :: NewAngle ! Angle to be converted to within 2*Pi of OldAngle, rad. + ! Local declarations: + + REAL(QuKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) > Pi_R16 ) + + NewAngle = NewAngle + SIGN( TwoPi_R16, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO RETURN - END SUBROUTINE AddOrSub2Pi + END SUBROUTINE AddOrSub2Pi_R16 !======================================================================= !> This routine sorts a list of real numbers. It uses the bubble sort algorithm, !! which is only suitable for short lists. @@ -3624,6 +3713,132 @@ FUNCTION InterpWrappedStpReal16( XValIn, XAry, YAry, Ind, AryLen ) END FUNCTION InterpWrappedStpReal16 !======================================================================= +!> This subroutine calculates interpolated values for an array of input values. +!! The size of the xknown and yknown arrays must match, and the size of the +!! xnew and ynew arrays must match. Xknown must be in ascending order. +!! Values outside the range of xknown are fixed to the end points. + SUBROUTINE InterpArrayR4( xknown, yknown, xnew, ynew ) + REAL(SiKi), INTENT(IN ) :: xknown(:) + REAL(SiKi), INTENT(IN ) :: yknown(:) + REAL(SiKi), INTENT(IN ) :: xnew(:) + REAL(SiKi), INTENT( OUT) :: ynew(:) + integer(IntKi) i,itmp,nknown + nknown=size(xknown) + do i=1,size(xnew) + itmp=minloc(abs(xnew(i)-xknown),dim=1) + if (itmp==nknown) then + if (xknown(itmp)>xnew(i)) then + ynew(i)=interp_lin0(xnew(i),xknown(itmp-1),xknown(itmp),yknown(itmp-1),yknown(itmp)) + else + ! The current x is above the max of xknown + ! extrapolation required, here fixed to upper bound + ynew(i)=yknown(nknown) + endif + elseif (xknown(itmp) \copydoc nwtc_num::interparrayr4 + SUBROUTINE InterpArrayR8( xknown, yknown, xnew, ynew ) + REAL(R8Ki), INTENT(IN ) :: xknown(:) + REAL(R8Ki), INTENT(IN ) :: yknown(:) + REAL(R8Ki), INTENT(IN ) :: xnew(:) + REAL(R8Ki), INTENT( OUT) :: ynew(:) + integer(IntKi) i,itmp,nknown + nknown=size(xknown) + do i=1,size(xnew) + itmp=minloc(abs(xnew(i)-xknown),dim=1) + if (itmp==nknown) then + if (xknown(itmp)>xnew(i)) then + ynew(i)=interp_lin0(xnew(i),xknown(itmp-1),xknown(itmp),yknown(itmp-1),yknown(itmp)) + else + ! The current x is above the max of xknown + ! extrapolation required, here fixed to upper bound + ynew(i)=yknown(nknown) + endif + elseif (xknown(itmp) \copydoc nwtc_num::interparrayr4 + SUBROUTINE InterpArrayR16( xknown, yknown, xnew, ynew ) + REAL(QuKi), INTENT(IN ) :: xknown(:) + REAL(QuKi), INTENT(IN ) :: yknown(:) + REAL(QuKi), INTENT(IN ) :: xnew(:) + REAL(QuKi), INTENT( OUT) :: ynew(:) + integer(IntKi) i,itmp,nknown + nknown=size(xknown) + do i=1,size(xnew) + itmp=minloc(abs(xnew(i)-xknown),dim=1) + if (itmp==nknown) then + if (xknown(itmp)>xnew(i)) then + ynew(i)=interp_lin0(xnew(i),xknown(itmp-1),xknown(itmp),yknown(itmp-1),yknown(itmp)) + else + ! The current x is above the max of xknown + ! extrapolation required, here fixed to upper bound + ynew(i)=yknown(nknown) + endif + elseif (xknown(itmp) This subroutine calculates the iosparametric coordinates, isopc, which is a value between -1 and 1 !! (for each dimension of a dataset), indicating where InCoord falls between posLo and posHi. !! It is used in InterpStpReal2D (nwtcnum::interpstpreal2d) and InterpStpReal3D (nwtcnum::interpstpreal3d). @@ -3947,29 +4162,78 @@ END FUNCTION Mean ! ( Ary, AryLen ) !======================================================================= !> This routine is used to convert Angle to an equivalent value !! between \f$-\pi\f$ and \f$pi\f$. - SUBROUTINE MPi2Pi ( Angle ) +!! +!! Use MPi2Pi (nwtc_num::mpi2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE MPi2Pi_R4 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< Angle (in radians) to be converted + REAL(SiKi), INTENT(INOUT) :: Angle !< Angle (in radians) to be converted + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R4 ) + + + ! Get the angle between -Pi and Pi. + + IF ( Angle > Pi_R4 ) THEN + Angle = Angle - TwoPi_R4 + END IF + + + RETURN + END SUBROUTINE MPi2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::mpi2pi_r4 + SUBROUTINE MPi2Pi_R8 ( Angle ) + + + ! Argument declarations: + + REAL(R8Ki), INTENT(INOUT) :: Angle + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R8 ) + + + ! Get the angle between -Pi and Pi. + + IF ( Angle > Pi_R8 ) THEN + Angle = Angle - TwoPi_R8 + END IF + + + RETURN + END SUBROUTINE MPi2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::mpi2pi_r4 + SUBROUTINE MPi2Pi_R16 ( Angle ) + + + ! Argument declarations: + REAL(QuKi), INTENT(INOUT) :: Angle ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, TwoPi_R16 ) ! Get the angle between -Pi and Pi. - IF ( Angle > Pi ) THEN - Angle = Angle - TwoPi + IF ( Angle > Pi_R16 ) THEN + Angle = Angle - TwoPi_R16 END IF RETURN - END SUBROUTINE MPi2Pi + END SUBROUTINE MPi2Pi_R16 !======================================================================= !> This function takes an angle in radians and converts it to !! an angle in degrees in the range [-180,180] @@ -4061,6 +4325,27 @@ FUNCTION OuterProductR16(u,v) END FUNCTION OuterProductR16 !======================================================================= +!> This subroutine perturbs an orientation matrix by a small angle, using +!! a logarithmic map. For small angles, the change in angle is equivalent to +!! a change in log map parameters. + SUBROUTINE PerturbOrientationMatrix( Orientation, Perturbation, AngleDim ) + REAL(R8Ki), INTENT(INOUT) :: Orientation(3,3) + REAL(R8Ki), INTENT(IN) :: Perturbation ! angle (radians) of the perturbation + INTEGER, INTENT(IN) :: AngleDim + + ! Local variables + REAL(R8Ki) :: angles(3) + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + CALL DCM_LogMap( Orientation, angles, ErrStat2, ErrMsg2 ) + + angles(AngleDim) = angles(AngleDim) + Perturbation + + Orientation = DCM_exp( angles ) + + END SUBROUTINE PerturbOrientationMatrix +!======================================================================= !> This routine factors the number N into its primes. If any of those !! prime factors is greater than the NumPrimes'th prime, a value of 1 !! is added to N and the new number is factored. This process is @@ -4858,7 +5143,7 @@ END SUBROUTINE RombergInt !======================================================================= !> This routine displays a message that gives that status of the simulation and the predicted end time of day. !! It is intended to be used with SimStatus (nwtc_num::simstatus) and SimStatus_FirstTime (nwtc_num::simstatus_firsttime). - SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_out, DescStrIn ) + SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, UsrTime_out, DescStrIn ) IMPLICIT NONE @@ -4869,6 +5154,7 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_o REAL(ReKi), INTENT(IN) :: UsrTime1 !< User CPU time for simulation initialization. REAL(ReKi), INTENT(IN) :: UsrTime2 !< User CPU time for simulation (without intialization) REAL(DbKi), INTENT(IN) :: ZTime !< The final simulation time (not necessarially TMax) + INTEGER(IntKi), INTENT(IN), OPTIONAL:: UnSum !< optional unit number of file. If present and > 0, REAL(ReKi), INTENT(OUT),OPTIONAL:: UsrTime_out !< User CPU time for entire run - optional value returned to calling routine CHARACTER(*), INTENT(IN), OPTIONAL :: DescStrIn !< optional additional string to print for SimStatus @@ -4944,6 +5230,19 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_o CALL WrScr ( ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) ) CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) ) + IF (PRESENT(UnSum)) THEN + IF (UnSum>0) THEN + WRITE( UnSum, '(//)' ) + WRITE( UnSum, '(A)') ' Total Real Time: '//TRIM( Num2LStr( Factor*ClckTime ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Total CPU Time: '//TRIM( Num2LStr( Factor*UsrTime ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Simulation CPU Time: '//TRIM( Num2LStr( Factor*UsrTimeSim ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) + END IF + END IF + + + ENDIF IF (PRESENT(UsrTime_out)) UsrTime_out = UsrTime @@ -4954,8 +5253,8 @@ FUNCTION GetClockTime(StartClockTime, EndClockTime) ! return the number of seconds between StartClockTime and EndClockTime REAL :: GetClockTime ! Elapsed clock time for the simulation phase of the run. - INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) - INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) !bjj: This calculation will be wrong at certain times (e.g. if it's near midnight on the last day of the month), but to my knowledge, no one has complained... GetClockTime = 0.001*( EndClockTime(8) - StartClockTime(8) ) & ! Is the milliseconds of the second (range 0 to 999) - local time @@ -5033,7 +5332,14 @@ SUBROUTINE SetConstants( ) TwoPi = 2.0_ReKi*Pi Inv2Pi = 0.5_ReKi/Pi ! 1.0/TwoPi + Pi_R4 = ACOS( -1.0_SiKi ) + Pi_R8 = ACOS( -1.0_R8Ki ) + Pi_R16 = ACOS( -1.0_QuKi ) + TwoPi_R4 = Pi_R4 *2.0_SiKi + TwoPi_R8 = Pi_R8 *2.0_R8Ki + TwoPi_R16 = Pi_R16*2.0_QuKi + ! IEEE constants: CALL Set_IEEE_Constants( NaN_D, Inf_D, NaN, Inf ) @@ -5172,7 +5478,7 @@ SUBROUTINE SimStatus( PrevSimTime, PrevClockTime, ZTime, TMax, DescStrIn ) PrevSimTime = ZTime RETURN - END SUBROUTINE SimStatus + END SUBROUTINE SimStatus !======================================================================= !> This routine computes the 3x3 transformation matrix, \f$TransMat\f$, !! to a coordinate system \f$x\f$ (with orthogonal axes \f$x_1, x_2, x_3\f$) @@ -5599,7 +5905,12 @@ SUBROUTINE SortUnion ( Ary1, N1, Ary2, N2, Ary, N ) END SUBROUTINE SortUnion ! ( Ary1, N1, Ary2, N2, Ary, N ) !======================================================================= !> This routine calculates the standard deviation of a population contained in Ary. - FUNCTION StdDevFn ( Ary, AryLen, Mean ) +!! +!! This can be calculated as either\n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N-1} } \f$ \n +!! or \n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N} } \f$ if `UseN` is true \n + FUNCTION StdDevFn ( Ary, AryLen, Mean, UseN ) ! Function declaration. @@ -5612,6 +5923,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(ReKi), INTENT(IN) :: Ary (AryLen) !< Input array. REAL(ReKi), INTENT(IN) :: Mean !< The previously calculated mean of the array. + LOGICAL, OPTIONAL, INTENT(IN) :: UseN !< Use `N` insted of `N-1` in denomenator ! Local declarations. @@ -5619,8 +5931,17 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(DbKi) :: Sum ! A temporary sum. INTEGER :: I ! The index into the array. + INTEGER :: Denom ! Denominator - + IF(PRESENT(UseN)) THEN + IF (UseN) THEN + Denom = AryLen + ELSE + Denom = AryLen-1 + ENDIF + ELSE + Denom = AryLen-1 + ENDIF Sum = 0.0_DbKi @@ -5628,7 +5949,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) Sum = Sum + ( Ary(I) - Mean )**2 END DO ! I - StdDevFn = SQRT( Sum/( AryLen - 1 ) ) + StdDevFn = SQRT( Sum/( Denom ) ) RETURN @@ -5712,6 +6033,7 @@ FUNCTION SkewSymMatR16 ( x ) RESULT(M) RETURN END FUNCTION SkewSymMatR16 + !======================================================================= !> This routine takes an array of time values such as that returned from !! CALL DATE_AND_TIME ( Values=TimeAry ) @@ -5786,7 +6108,6 @@ FUNCTION traceR16(A) end do END FUNCTION traceR16 - !======================================================================= !> This function returns the \f$l_2\f$ (Euclidian) norm of a vector, !! \f$v = \left(v_1, v_2, \ldots ,v_n\right)\f$. The \f$l_2\f$-norm is defined as @@ -5837,30 +6158,58 @@ FUNCTION TwoNormR16(v) !> This routine is used to convert Angle to an equivalent value !! in the range \f$[0, 2\pi)\f$. \n !! Use Zero2TwoPi (nwtc_num::zero2twopi) instead of directly calling a specific routine in the generic interface. - SUBROUTINE Zero2TwoPiR ( Angle ) + SUBROUTINE Zero2TwoPiR4 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ + REAL(SiKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, TwoPi_R4 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi ) THEN + IF ( Angle == TwoPi_R4 ) THEN Angle = 0.0_ReKi END IF RETURN - END SUBROUTINE Zero2TwoPiR + END SUBROUTINE Zero2TwoPiR4 +!======================================================================= +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR8 ( Angle ) + + ! This routine is used to convert Angle to an equivalent value + ! in the range [0, 2*pi). + + + ! Argument declarations: + + REAL(R8Ki), INTENT(INOUT) :: Angle + + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R8 ) + + + ! Check numerical case where Angle == 2Pi. + + IF ( Angle == TwoPi_R8 ) THEN + Angle = 0.0_DbKi + END IF + + + RETURN + END SUBROUTINE Zero2TwoPiR8 !======================================================================= -!> \copydoc nwtc_num::zero2twopir - SUBROUTINE Zero2TwoPiD ( Angle ) +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR16 ( Angle ) ! This routine is used to convert Angle to an equivalent value ! in the range [0, 2*pi). @@ -5868,23 +6217,340 @@ SUBROUTINE Zero2TwoPiD ( Angle ) ! Argument declarations: - REAL(DbKi), INTENT(INOUT) :: Angle + REAL(QuKi), INTENT(INOUT) :: Angle ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi_D ) + Angle = MODULO( Angle, TwoPi_R16 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi_D ) THEN + IF ( Angle == TwoPi_R16 ) THEN Angle = 0.0_DbKi END IF RETURN - END SUBROUTINE Zero2TwoPiD + END SUBROUTINE Zero2TwoPiR16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R4(Angle1, Angle2, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(SiKi) :: Angle2_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) + +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R8(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(R8Ki) :: Angle2_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R16(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(QuKi) :: Angle2_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R4(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(SiKi) :: Angle2_mod + REAL(SiKi) :: Angle3_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out + +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R8(Angle1, Angle2, Angle3, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(R8Ki) :: Angle2_mod + REAL(R8Ki) :: Angle3_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R16(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(QuKi) :: Angle2_mod + REAL(QuKi) :: Angle3_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R16 !======================================================================= END MODULE NWTC_Num diff --git a/modules/nwtc-library/src/NWTC_RandomNumber.f90 b/modules/nwtc-library/src/NWTC_RandomNumber.f90 new file mode 100644 index 0000000000..ed8b6648f6 --- /dev/null +++ b/modules/nwtc-library/src/NWTC_RandomNumber.f90 @@ -0,0 +1,190 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020 National Renewable Energy Laboratory +! +! This file is part of NWTC Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +!********************************************************************************************************************************** + +MODULE NWTC_RandomNumber + +USE Ran_Lux_Mod +USE NWTC_Library_Types +USE NWTC_IO + +IMPLICIT NONE + +INTEGER(IntKi), PARAMETER :: pRNG_RANLUX = 1 +INTEGER(IntKi), PARAMETER :: pRNG_INTRINSIC = 2 + +INTEGER, PARAMETER :: LuxLevel = 3 ! Luxury Level for RanLux RNG + +!> \copydoc nwtc_randomnumber::uniformrandomnumbersr4 +INTERFACE UniformRandomNumbers +MODULE PROCEDURE UniformRandomNumbersR4 ! 4-byte reals +MODULE PROCEDURE UniformRandomNumbersR8 ! 8-byte reals +MODULE PROCEDURE UniformRandomNumbersR16 ! 16-byte reals +END INTERFACE + +CONTAINS + +SUBROUTINE RandNum_Init(p, ErrStat, ErrMsg ) + + ! Initialize the Random Number Generators + + IMPLICIT NONE + + TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN ) :: p ! PARAMETERs for random number generation + INTEGER(IntKi) , INTENT(OUT) :: ErrStat ! allocation status + CHARACTER(*) , INTENT(OUT) :: ErrMsg ! error message + + INTEGER :: I ! loop counter + INTEGER(IntKi), ALLOCATABLE :: NextSeed(:) ! The array that holds the next random seed for each component + INTEGER :: NumSeeds ! number of seeds in the intrinsic random number generator + + ErrStat = ErrID_None + ErrMsg = "" + + IF (p%pRNG == pRNG_RANLUX) THEN + + CALL RLuxGo ( LuxLevel, ABS( p%RandSeed(1) ), 0, 0 ) + + IF (.NOT. ALLOCATED( NextSeed ) ) THEN + CALL AllocAry( NextSeed, 2, 'nextSeed', ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN + END IF + + ELSEIF (p%pRNG == pRNG_INTRINSIC) THEN + + ! determine the number of seeds necessary (gfortran needs 8 or 12 seeds, not just 2) + + CALL RANDOM_SEED ( SIZE = NumSeeds ) + + IF ( NumSeeds /= 2 ) THEN + CALL ProgWarn( ' The random number generator in use differs from the original code provided by NREL. This pRNG uses ' & + //trim(Int2LStr(NumSeeds))//' seeds instead of the 2 in the input file.') + END IF + + IF ( .NOT. ALLOCATED( NextSeed ) ) THEN + CALL AllocAry( NextSeed, NumSeeds, 'nextSeed', ErrSTat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN + END IF + + ! We'll just populate this with odd seeds = Seed(1) and even seeds = Seed(2) + DO I = 1, NumSeeds,2 + NextSeed(I) = p%RandSeed(1) + END DO + DO I = 2, NumSeeds,2 + NextSeed(I) = p%RandSeed(2) + END DO + + CALL RANDOM_SEED( PUT=NextSeed ) + + ELSE + + ! Invalid pRNG requested + ErrMsg = "Invalid pRNG requested." + ErrStat = ErrID_Fatal + RETURN + + END IF + +END SUBROUTINE RandNum_Init + +!======================================================================= +!> This subroutine produces uniformly distributed random numbers, based on +!! the pRNG requested. This routine assumes that the random number +!! generator has been initialized earlier in the main program. +SUBROUTINE UniformRandomNumbersR4( pRNG_Type, RandomNumbers ) + + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: pRNG_Type + REAL(SiKi), INTENT( OUT), DIMENSION(:) :: RandomNumbers + + REAL(ReKi), ALLOCATABLE :: RN(:) + + IF ( pRNG_Type == pRNG_INTRINSIC ) THEN + + ! The Fortran intrinsic has an interface for various floating + ! point types, so pass the variable directly + CALL RANDOM_NUMBER( RandomNumbers ) + + ELSEIF ( pRNG_Type == pRNG_RANLUX ) THEN + + ! RanLux, as implemented, uses ReKi, so cast the return value as needed + ALLOCATE( RN( SIZE(RandomNumbers) ) ) + CALL RanLux ( RN ) + RandomNumbers = REAL(RN, KIND=SiKi) + + END IF + +END SUBROUTINE UniformRandomNumbersR4 +!======================================================================= +!> \copydoc nwtc_randomnumber::uniformrandomnumbersr4 +SUBROUTINE UniformRandomNumbersR8( pRNG_Type, RandomNumbers ) + + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: pRNG_Type + REAL(R8Ki), INTENT( OUT), DIMENSION(:) :: RandomNumbers + + REAL(ReKi), ALLOCATABLE :: RN(:) + + IF ( pRNG_Type == pRNG_INTRINSIC ) THEN + + ! The Fortran intrinsic has an interface for various floating + ! point types, so pass the variable directly + CALL RANDOM_NUMBER( RandomNumbers ) + + ELSEIF ( pRNG_Type == pRNG_RANLUX ) THEN + + ! RanLux, as implemented, uses ReKi, so cast the return value as needed + ALLOCATE( RN( SIZE(RandomNumbers) ) ) + CALL RanLux ( RN ) + RandomNumbers = REAL(RN, KIND=R8Ki) + + END IF + +END SUBROUTINE UniformRandomNumbersR8 +!======================================================================= +!> \copydoc nwtc_randomnumber::uniformrandomnumbersr4 +SUBROUTINE UniformRandomNumbersR16( pRNG_Type, RandomNumbers ) + + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: pRNG_Type + REAL(QuKi), INTENT( OUT), DIMENSION(:) :: RandomNumbers + + REAL(ReKi), ALLOCATABLE :: RN(:) + + IF ( pRNG_Type == pRNG_INTRINSIC ) THEN + + ! The Fortran intrinsic has an interface for various floating + ! point types, so pass the variable directly + CALL RANDOM_NUMBER( RandomNumbers ) + + ELSEIF ( pRNG_Type == pRNG_RANLUX ) THEN + + ! RanLux, as implemented, uses ReKi, so cast the return value as needed + ALLOCATE( RN( SIZE(RandomNumbers) ) ) + CALL RanLux ( RN ) + RandomNumbers = REAL(RN, KIND=QuKi) + + END IF + +END SUBROUTINE UniformRandomNumbersR16 + +END MODULE diff --git a/modules/nwtc-library/src/NetLib/fftpack/NWTC_FFTPACK.f90 b/modules/nwtc-library/src/NetLib/fftpack/NWTC_FFTPACK.f90 index 880a164854..21a3840e39 100644 --- a/modules/nwtc-library/src/NetLib/fftpack/NWTC_FFTPACK.f90 +++ b/modules/nwtc-library/src/NetLib/fftpack/NWTC_FFTPACK.f90 @@ -175,7 +175,7 @@ SUBROUTINE ApplyCFFT( TRH_complex_return, TRH_complex, FFT_Data, ErrStat ) INTEGER(IntKi) :: ErrStatTmp LOGICAL :: TrapErrors - character(1024) :: ErrMsg + character(ErrMsgLen) :: ErrMsg ErrStatTmp = ErrID_None @@ -272,7 +272,7 @@ SUBROUTINE ApplyCFFT_f( TRH_complex, FFT_Data, ErrStat ) REAL(SiKi), ALLOCATABLE :: TRH(:) LOGICAL :: TrapErrors - character(1024) :: ErrMsg + character(ErrMsgLen) :: ErrMsg IF ( PRESENT(ErrStat) ) THEN diff --git a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 index f82fff275c..99cdd7a088 100644 --- a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 +++ b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 @@ -99,7 +99,54 @@ MODULE NWTC_LAPACK MODULE PROCEDURE LAPACK_sgesvd END INTERFACE + +!> straight-up lapack routines (from ExtPtfm_MCKF): + INTERFACE LAPACK_COPY + SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) + USE Precision, only: R8Ki + INTEGER :: INCX,INCY,N + real(R8Ki) :: DX(*),DY(*) + ENDSUBROUTINE + SUBROUTINE SCOPY(N,X,INCX,Y,INCY) + USE Precision, only: SiKi + INTEGER :: INCX,INCY,N + real(SiKi) :: X(*),Y(*) + ENDSUBROUTINE + END INTERFACE + + INTERFACE LAPACK_GEMV + SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + USE Precision, only: R8Ki + real(R8Ki) :: ALPHA,BETA + integer :: INCX,INCY,LDA,M,N + character :: TRANS + real(R8Ki) :: A(LDA,*),X(*),Y(*) + ENDSUBROUTINE + SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + USE Precision, only: SiKi + real(SiKi) :: ALPHA,BETA + integer :: INCX,INCY,LDA,M,N + character :: TRANS + real(SiKi) :: A(LDA,*),X(*),Y(*) + ENDSUBROUTINE + END INTERFACE LAPACK_GEMV + + INTERFACE LAPACK_AXPY + SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) + USE Precision, only: R8Ki + real(R8Ki) :: DA + integer :: INCX,INCY,N + real(R8Ki) :: DX(*),DY(*) + ENDSUBROUTINE + SUBROUTINE SAXPY(N,A,X,INCX,Y,INCY) + USE Precision, only: SiKi + real(SiKi) :: A + integer :: INCX,INCY,N + real(SiKi) :: X(*),Y(*) + ENDSUBROUTINE + END INTERFACE + CONTAINS !======================================================================= diff --git a/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 b/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 new file mode 100644 index 0000000000..68fe207779 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 @@ -0,0 +1,67 @@ +!********************************************************************************************************************************** +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +!> This code provides a wrapper for the SLATEC routines currently used at the NWTC (mainly codes in the FAST framework). This +!! enables us to call generic routines (not single- or double-precision specific ones) so that we don't have to change source +!! code to compile in double vs. single precision. +! +!********************************************************************************************************************************** +MODULE NWTC_SLATEC + + USE NWTC_Base ! we only need the precision and error level constants + + + ! Notes: + + ! Your project must include the following files: + ! From the NWTC Subroutine Library: + ! SingPrec.f90 [from NWTC Library] + ! Sys*.f90 [from NWTC Library] + ! NWTC_Base.f90 [from NWTC Library] + ! lapack library (preferably a binary, but available in source form from http://www.netlib.org/, too) + ! This wrapper file: + ! NWTC_SLATEC.f90 + + ! NOTES: + ! The routines in the slatec library use REAL and DOUBLE PRECISION. When compiling in double precision + ! the -fdefault-real-8 option is used, which promotes all DOUBLE to QUAD. Therefore the interaces here + ! are done using ReKi and DBKi to interface to the appropriate library. This allows the user to specify + ! the typing of variables passed to these routines as ReKi, DBKi, or R8Ki. + ! Note that SiKi can'bt be specified in the calling variable type as it will still be kind=4, which + ! won't have any promoted routines to match to in DOUBLE precision compiles. + + ! http://www.netlib.org/slatec/explore-html/ + + + IMPLICIT NONE + + !> integrate an external function using the 61-point kronrod rule + interface slatec_qk61 + module procedure wrap_qk61 + module procedure wrap_dqk61 + end interface + + CONTAINS + + + !> Single precision wrapper for the qk61 integration routine from the slatec library + !! Note that the qk61 routine follows -fdefault-real-8 setting, so it is of type ReKi + subroutine wrap_qk61(func,low,hi,answer,abserr,resabs,resasc) + real(ReKi), intent(in ) :: low,hi ! integration limits + real(ReKi), intent( out) :: answer + real(ReKi), intent(in ) :: abserr,resabs,resasc + real(ReKi), external :: func ! function + call qk61(func,low,hi,answer,abserr,resabs,resasc) + end subroutine wrap_qk61 + + !> Double precision wrapper for the dqk61 integration routine from the slatec library + !! Note that the qk61 routine follows -fdefault-real-8 setting, so it is of type DbKi + subroutine wrap_dqk61(func,low,hi,answer,abserr,resabs,resasc) + real(DbKi), intent(in ) :: low,hi ! integration limits + real(DbKi), intent( out) :: answer + real(DbKi), intent(in ) :: abserr,resabs,resasc + real(DbKi), external :: func ! function + call dqk61(func,low,hi,answer,abserr,resabs,resasc) + end subroutine wrap_dqk61 + +END MODULE NWTC_SLATEC diff --git a/modules/nwtc-library/src/NetLib/slatec/aaaaaa.f b/modules/nwtc-library/src/NetLib/slatec/aaaaaa.f new file mode 100644 index 0000000000..ef2a541e94 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/aaaaaa.f @@ -0,0 +1,71 @@ +*DECK AAAAAA + SUBROUTINE AAAAAA (VER) +C***BEGIN PROLOGUE AAAAAA +C***PURPOSE SLATEC Common Mathematical Library disclaimer and version. +C***LIBRARY SLATEC +C***CATEGORY Z +C***TYPE ALL (AAAAAA-A) +C***KEYWORDS DISCLAIMER, DOCUMENTATION, VERSION +C***AUTHOR SLATEC Common Mathematical Library Committee +C***DESCRIPTION +C +C The SLATEC Common Mathematical Library is issued by the following +C +C Air Force Weapons Laboratory, Albuquerque +C Lawrence Livermore National Laboratory, Livermore +C Los Alamos National Laboratory, Los Alamos +C National Institute of Standards and Technology, Washington +C National Energy Research Supercomputer Center, Livermore +C Oak Ridge National Laboratory, Oak Ridge +C Sandia National Laboratories, Albuquerque +C Sandia National Laboratories, Livermore +C +C All questions concerning the distribution of the library should be +C directed to the NATIONAL ENERGY SOFTWARE CENTER, 9700 Cass Ave., +C Argonne, Illinois 60439, and not to the authors of the subprograms. +C +C * * * * * Notice * * * * * +C +C This material was prepared as an account of work sponsored by the +C United States Government. Neither the United States, nor the +C Department of Energy, nor the Department of Defense, nor any of +C their employees, nor any of their contractors, subcontractors, or +C their employees, makes any warranty, expressed or implied, or +C assumes any legal liability or responsibility for the accuracy, +C completeness, or usefulness of any information, apparatus, product, +C or process disclosed, or represents that its use would not infringe +C upon privately owned rights. +C +C *Usage: +C +C CHARACTER * 16 VER +C +C CALL AAAAAA (VER) +C +C *Arguments: +C +C VER:OUT will contain the version number of the SLATEC CML. +C +C *Description: +C +C This routine contains the SLATEC Common Mathematical Library +C disclaimer and can be used to return the library version number. +C +C***REFERENCES Kirby W. Fong, Thomas H. Jefferson, Tokihiko Suyehiro +C and Lee Walton, Guide to the SLATEC Common Mathema- +C tical Library, April 10, 1990. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 800424 DATE WRITTEN +C 890414 REVISION DATE from Version 3.2 +C 890713 Routine modified to return version number. (WRB) +C 900330 Prologue converted to Version 4.0 format. (BAB) +C 920501 Reformatted the REFERENCES section. (WRB) +C 921215 Updated for Version 4.0. (WRB) +C 930701 Updated for Version 4.1. (WRB) +C***END PROLOGUE AAAAAA + CHARACTER * (*) VER +C***FIRST EXECUTABLE STATEMENT AAAAAA + VER = ' 4.1' + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/d1mach.f b/modules/nwtc-library/src/NetLib/slatec/d1mach.f new file mode 100644 index 0000000000..6f10f7035a --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/d1mach.f @@ -0,0 +1,502 @@ +*DECK D1MACH + DOUBLE PRECISION FUNCTION D1MACH (I) +C***BEGIN PROLOGUE D1MACH +C***PURPOSE Return floating point machine dependent constants. +C***LIBRARY SLATEC +C***CATEGORY R1 +C***TYPE DOUBLE PRECISION (R1MACH-S, D1MACH-D) +C***KEYWORDS MACHINE CONSTANTS +C***AUTHOR Fox, P. A., (Bell Labs) +C Hall, A. D., (Bell Labs) +C Schryer, N. L., (Bell Labs) +C***DESCRIPTION +C +C D1MACH can be used to obtain machine-dependent parameters for the +C local machine environment. It is a function subprogram with one +C (input) argument, and can be referenced as follows: +C +C D = D1MACH(I) +C +C where I=1,...,5. The (output) value of D above is determined by +C the (input) value of I. The results for various values of I are +C discussed below. +C +C D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude. +C D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude. +C D1MACH( 3) = B**(-T), the smallest relative spacing. +C D1MACH( 4) = B**(1-T), the largest relative spacing. +C D1MACH( 5) = LOG10(B) +C +C Assume double precision numbers are represented in the T-digit, +C base-B form +C +C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and +C EMIN .LE. E .LE. EMAX. +C +C The values of B, T, EMIN and EMAX are provided in I1MACH as +C follows: +C I1MACH(10) = B, the base. +C I1MACH(14) = T, the number of base-B digits. +C I1MACH(15) = EMIN, the smallest exponent E. +C I1MACH(16) = EMAX, the largest exponent E. +C +C To alter this function for a particular environment, the desired +C set of DATA statements should be activated by removing the C from +C column 1. Also, the values of D1MACH(1) - D1MACH(4) should be +C checked for consistency with the local operating system. +C +C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for +C a portable library, ACM Transactions on Mathematical +C Software 4, 2 (June 1978), pp. 177-188. +C***ROUTINES CALLED XERMSG +C***REVISION HISTORY (YYMMDD) +C 750101 DATE WRITTEN +C 890213 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 900618 Added DEC RISC constants. (WRB) +C 900723 Added IBM RS 6000 constants. (WRB) +C 900911 Added SUN 386i constants. (WRB) +C 910710 Added HP 730 constants. (SMR) +C 911114 Added Convex IEEE constants. (WRB) +C 920121 Added SUN -r8 compiler option constants. (WRB) +C 920229 Added Touchstone Delta i860 constants. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C 920625 Added CONVEX -p8 and -pd8 compiler option constants. +C (BKS, WRB) +C 930201 Added DEC Alpha and SGI constants. (RWC and WRB) +C***END PROLOGUE D1MACH +C + INTEGER SMALL(4) + INTEGER LARGE(4) + INTEGER RIGHT(4) + INTEGER DIVER(4) + INTEGER LOG10(4) +C + DOUBLE PRECISION DMACH(5) + SAVE DMACH +C + EQUIVALENCE (DMACH(1),SMALL(1)) + EQUIVALENCE (DMACH(2),LARGE(1)) + EQUIVALENCE (DMACH(3),RIGHT(1)) + EQUIVALENCE (DMACH(4),DIVER(1)) + EQUIVALENCE (DMACH(5),LOG10(1)) +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FDFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE APOLLO +C +C DATA SMALL(1), SMALL(2) / 16#00100000, 16#00000000 / +C DATA LARGE(1), LARGE(2) / 16#7FFFFFFF, 16#FFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / 16#3CA00000, 16#00000000 / +C DATA DIVER(1), DIVER(2) / 16#3CB00000, 16#00000000 / +C DATA LOG10(1), LOG10(2) / 16#3FD34413, 16#509F79FF / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM +C +C DATA SMALL(1) / ZC00800000 / +C DATA SMALL(2) / Z000000000 / +C DATA LARGE(1) / ZDFFFFFFFF / +C DATA LARGE(2) / ZFFFFFFFFF / +C DATA RIGHT(1) / ZCC5800000 / +C DATA RIGHT(2) / Z000000000 / +C DATA DIVER(1) / ZCC6800000 / +C DATA DIVER(2) / Z000000000 / +C DATA LOG10(1) / ZD00E730E7 / +C DATA LOG10(2) / ZC77800DC0 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O0000000000000000 / +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O0007777777777777 / +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O7770000000000000 / +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O7777777777777777 / +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 / +C +C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE +C +C DATA SMALL(1) / Z"3001800000000000" / +C DATA SMALL(2) / Z"3001000000000000" / +C DATA LARGE(1) / Z"4FFEFFFFFFFFFFFE" / +C DATA LARGE(2) / Z"4FFE000000000000" / +C DATA RIGHT(1) / Z"3FD2800000000000" / +C DATA RIGHT(2) / Z"3FD2000000000000" / +C DATA DIVER(1) / Z"3FD3800000000000" / +C DATA DIVER(2) / Z"3FD3000000000000" / +C DATA LOG10(1) / Z"3FFF9A209A84FBCF" / +C DATA LOG10(2) / Z"3FFFF7988F8959AC" / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES +C +C DATA SMALL(1) / 00564000000000000000B / +C DATA SMALL(2) / 00000000000000000000B / +C DATA LARGE(1) / 37757777777777777777B / +C DATA LARGE(2) / 37157777777777777777B / +C DATA RIGHT(1) / 15624000000000000000B / +C DATA RIGHT(2) / 00000000000000000000B / +C DATA DIVER(1) / 15634000000000000000B / +C DATA DIVER(2) / 00000000000000000000B / +C DATA LOG10(1) / 17164642023241175717B / +C DATA LOG10(2) / 16367571421742254654B / +C +C MACHINE CONSTANTS FOR THE CELERITY C1260 +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fn OR -pd8 COMPILER OPTION +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CC0000000000000' / +C DATA DMACH(4) / Z'3CD0000000000000' / +C DATA DMACH(5) / Z'3FF34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fi COMPILER OPTION +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -p8 COMPILER OPTION +C +C DATA DMACH(1) / Z'00010000000000000000000000000000' / +C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3F900000000000000000000000000000' / +C DATA DMACH(4) / Z'3F910000000000000000000000000000' / +C DATA DMACH(5) / Z'3FFF34413509F79FEF311F12B35816F9' / +C +C MACHINE CONSTANTS FOR THE CRAY +C +C DATA SMALL(1) / 201354000000000000000B / +C DATA SMALL(2) / 000000000000000000000B / +C DATA LARGE(1) / 577767777777777777777B / +C DATA LARGE(2) / 000007777777777777774B / +C DATA RIGHT(1) / 376434000000000000000B / +C DATA RIGHT(2) / 000000000000000000000B / +C DATA DIVER(1) / 376444000000000000000B / +C DATA DIVER(2) / 000000000000000000000B / +C DATA LOG10(1) / 377774642023241175717B / +C DATA LOG10(2) / 000007571421742254654B / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - +C STATIC DMACH(5) +C +C DATA SMALL / 20K, 3*0 / +C DATA LARGE / 77777K, 3*177777K / +C DATA RIGHT / 31420K, 3*0 / +C DATA DIVER / 32020K, 3*0 / +C DATA LOG10 / 40423K, 42023K, 50237K, 74776K / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING G_FLOAT +C +C DATA DMACH(1) / '0000000000000010'X / +C DATA DMACH(2) / 'FFFFFFFFFFFF7FFF'X / +C DATA DMACH(3) / '0000000000003CC0'X / +C DATA DMACH(4) / '0000000000003CD0'X / +C DATA DMACH(5) / '79FF509F44133FF3'X / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING IEEE_FORMAT +C +C DATA DMACH(1) / '0010000000000000'X / +C DATA DMACH(2) / '7FEFFFFFFFFFFFFF'X / +C DATA DMACH(3) / '3CA0000000000000'X / +C DATA DMACH(4) / '3CB0000000000000'X / +C DATA DMACH(5) / '3FD34413509F79FF'X / +C +C MACHINE CONSTANTS FOR THE DEC RISC +C +C DATA SMALL(1), SMALL(2) / Z'00000000', Z'00100000'/ +C DATA LARGE(1), LARGE(2) / Z'FFFFFFFF', Z'7FEFFFFF'/ +C DATA RIGHT(1), RIGHT(2) / Z'00000000', Z'3CA00000'/ +C DATA DIVER(1), DIVER(2) / Z'00000000', Z'3CB00000'/ +C DATA LOG10(1), LOG10(2) / Z'509F79FF', Z'3FD34413'/ +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING D_FLOATING +C (EXPRESSED IN INTEGER AND HEXADECIMAL) +C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS +C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS +C +C DATA SMALL(1), SMALL(2) / 128, 0 / +C DATA LARGE(1), LARGE(2) / -32769, -1 / +C DATA RIGHT(1), RIGHT(2) / 9344, 0 / +C DATA DIVER(1), DIVER(2) / 9472, 0 / +C DATA LOG10(1), LOG10(2) / 546979738, -805796613 / +C +C DATA SMALL(1), SMALL(2) / Z00000080, Z00000000 / +C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / Z00002480, Z00000000 / +C DATA DIVER(1), DIVER(2) / Z00002500, Z00000000 / +C DATA LOG10(1), LOG10(2) / Z209A3F9A, ZCFF884FB / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING G_FLOATING +C (EXPRESSED IN INTEGER AND HEXADECIMAL) +C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS +C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS +C +C DATA SMALL(1), SMALL(2) / 16, 0 / +C DATA LARGE(1), LARGE(2) / -32769, -1 / +C DATA RIGHT(1), RIGHT(2) / 15552, 0 / +C DATA DIVER(1), DIVER(2) / 15568, 0 / +C DATA LOG10(1), LOG10(2) / 1142112243, 2046775455 / +C +C DATA SMALL(1), SMALL(2) / Z00000010, Z00000000 / +C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / Z00003CC0, Z00000000 / +C DATA DIVER(1), DIVER(2) / Z00003CD0, Z00000000 / +C DATA LOG10(1), LOG10(2) / Z44133FF3, Z79FF509F / +C +C MACHINE CONSTANTS FOR THE ELXSI 6400 +C (ASSUMING REAL*8 IS THE DEFAULT DOUBLE PRECISION) +C +C DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X / +C DATA LARGE(1), LARGE(2) / '7FEFFFFF'X,'FFFFFFFF'X / +C DATA RIGHT(1), RIGHT(2) / '3CB00000'X,'00000000'X / +C DATA DIVER(1), DIVER(2) / '3CC00000'X,'00000000'X / +C DATA LOG10(1), LOG10(2) / '3FD34413'X,'509F79FF'X / +C +C MACHINE CONSTANTS FOR THE HARRIS 220 +C +C DATA SMALL(1), SMALL(2) / '20000000, '00000201 / +C DATA LARGE(1), LARGE(2) / '37777777, '37777577 / +C DATA RIGHT(1), RIGHT(2) / '20000000, '00000333 / +C DATA DIVER(1), DIVER(2) / '20000000, '00000334 / +C DATA LOG10(1), LOG10(2) / '23210115, '10237777 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES +C +C DATA SMALL(1), SMALL(2) / O402400000000, O000000000000 / +C DATA LARGE(1), LARGE(2) / O376777777777, O777777777777 / +C DATA RIGHT(1), RIGHT(2) / O604400000000, O000000000000 / +C DATA DIVER(1), DIVER(2) / O606400000000, O000000000000 / +C DATA LOG10(1), LOG10(2) / O776464202324, O117571775714 / +C +C MACHINE CONSTANTS FOR THE HP 730 +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C THREE WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA SMALL(1), SMALL(2), SMALL(3) / 40000B, 0, 1 / +C DATA LARGE(1), LARGE(2), LARGE(3) / 77777B, 177777B, 177776B / +C DATA RIGHT(1), RIGHT(2), RIGHT(3) / 40000B, 0, 265B / +C DATA DIVER(1), DIVER(2), DIVER(3) / 40000B, 0, 276B / +C DATA LOG10(1), LOG10(2), LOG10(3) / 46420B, 46502B, 77777B / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C FOUR WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA SMALL(1), SMALL(2) / 40000B, 0 / +C DATA SMALL(3), SMALL(4) / 0, 1 / +C DATA LARGE(1), LARGE(2) / 77777B, 177777B / +C DATA LARGE(3), LARGE(4) / 177777B, 177776B / +C DATA RIGHT(1), RIGHT(2) / 40000B, 0 / +C DATA RIGHT(3), RIGHT(4) / 0, 225B / +C DATA DIVER(1), DIVER(2) / 40000B, 0 / +C DATA DIVER(3), DIVER(4) / 0, 227B / +C DATA LOG10(1), LOG10(2) / 46420B, 46502B / +C DATA LOG10(3), LOG10(4) / 76747B, 176377B / +C +C MACHINE CONSTANTS FOR THE HP 9000 +C +C DATA SMALL(1), SMALL(2) / 00040000000B, 00000000000B / +C DATA LARGE(1), LARGE(2) / 17737777777B, 37777777777B / +C DATA RIGHT(1), RIGHT(2) / 07454000000B, 00000000000B / +C DATA DIVER(1), DIVER(2) / 07460000000B, 00000000000B / +C DATA LOG10(1), LOG10(2) / 07764642023B, 12047674777B / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND +C THE PERKIN ELMER (INTERDATA) 7/32. +C +C DATA SMALL(1), SMALL(2) / Z00100000, Z00000000 / +C DATA LARGE(1), LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / +C DATA RIGHT(1), RIGHT(2) / Z33100000, Z00000000 / +C DATA DIVER(1), DIVER(2) / Z34100000, Z00000000 / +C DATA LOG10(1), LOG10(2) / Z41134413, Z509F79FF / +C +C MACHINE CONSTANTS FOR THE IBM PC +C ASSUMES THAT ALL ARITHMETIC IS DONE IN DOUBLE PRECISION +C ON 8088, I.E., NOT IN 80 BIT FORM FOR THE 8087. +C +C DATA SMALL(1) / 2.23D-308 / +C DATA LARGE(1) / 1.79D+308 / +C DATA RIGHT(1) / 1.11D-16 / +C DATA DIVER(1) / 2.22D-16 / +C DATA LOG10(1) / 0.301029995663981195D0 / +C +C MACHINE CONSTANTS FOR THE IBM RS 6000 +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE INTEL i860 +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR) +C +C DATA SMALL(1), SMALL(2) / "033400000000, "000000000000 / +C DATA LARGE(1), LARGE(2) / "377777777777, "344777777777 / +C DATA RIGHT(1), RIGHT(2) / "113400000000, "000000000000 / +C DATA DIVER(1), DIVER(2) / "114400000000, "000000000000 / +C DATA LOG10(1), LOG10(2) / "177464202324, "144117571776 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR) +C +C DATA SMALL(1), SMALL(2) / "000400000000, "000000000000 / +C DATA LARGE(1), LARGE(2) / "377777777777, "377777777777 / +C DATA RIGHT(1), RIGHT(2) / "103400000000, "000000000000 / +C DATA DIVER(1), DIVER(2) / "104400000000, "000000000000 / +C DATA LOG10(1), LOG10(2) / "177464202324, "476747767461 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1), SMALL(2) / 8388608, 0 / +C DATA LARGE(1), LARGE(2) / 2147483647, -1 / +C DATA RIGHT(1), RIGHT(2) / 612368384, 0 / +C DATA DIVER(1), DIVER(2) / 620756992, 0 / +C DATA LOG10(1), LOG10(2) / 1067065498, -2063872008 / +C +C DATA SMALL(1), SMALL(2) / O00040000000, O00000000000 / +C DATA LARGE(1), LARGE(2) / O17777777777, O37777777777 / +C DATA RIGHT(1), RIGHT(2) / O04440000000, O00000000000 / +C DATA DIVER(1), DIVER(2) / O04500000000, O00000000000 / +C DATA LOG10(1), LOG10(2) / O07746420232, O20476747770 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1), SMALL(2) / 128, 0 / +C DATA SMALL(3), SMALL(4) / 0, 0 / +C DATA LARGE(1), LARGE(2) / 32767, -1 / +C DATA LARGE(3), LARGE(4) / -1, -1 / +C DATA RIGHT(1), RIGHT(2) / 9344, 0 / +C DATA RIGHT(3), RIGHT(4) / 0, 0 / +C DATA DIVER(1), DIVER(2) / 9472, 0 / +C DATA DIVER(3), DIVER(4) / 0, 0 / +C DATA LOG10(1), LOG10(2) / 16282, 8346 / +C DATA LOG10(3), LOG10(4) / -31493, -12296 / +C +C DATA SMALL(1), SMALL(2) / O000200, O000000 / +C DATA SMALL(3), SMALL(4) / O000000, O000000 / +C DATA LARGE(1), LARGE(2) / O077777, O177777 / +C DATA LARGE(3), LARGE(4) / O177777, O177777 / +C DATA RIGHT(1), RIGHT(2) / O022200, O000000 / +C DATA RIGHT(3), RIGHT(4) / O000000, O000000 / +C DATA DIVER(1), DIVER(2) / O022400, O000000 / +C DATA DIVER(3), DIVER(4) / O000000, O000000 / +C DATA LOG10(1), LOG10(2) / O037632, O020232 / +C DATA LOG10(3), LOG10(4) / O102373, O147770 / +C +C MACHINE CONSTANTS FOR THE SILICON GRAPHICS +C +C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE SUN +C +C DATA DMACH(1) / Z'0010000000000000' / +C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3CA0000000000000' / +C DATA DMACH(4) / Z'3CB0000000000000' / +C DATA DMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE SUN +C USING THE -r8 COMPILER OPTION +C +C DATA DMACH(1) / Z'00010000000000000000000000000000' / +C DATA DMACH(2) / Z'7FFEFFFFFFFFFFFFFFFFFFFFFFFFFFFF' / +C DATA DMACH(3) / Z'3F8E0000000000000000000000000000' / +C DATA DMACH(4) / Z'3F8F0000000000000000000000000000' / +C DATA DMACH(5) / Z'3FFD34413509F79FEF311F12B35816F9' / +C +C MACHINE CONSTANTS FOR THE SUN 386i +C +C DATA SMALL(1), SMALL(2) / Z'FFFFFFFD', Z'000FFFFF' / +C DATA LARGE(1), LARGE(2) / Z'FFFFFFB0', Z'7FEFFFFF' / +C DATA RIGHT(1), RIGHT(2) / Z'000000B0', Z'3CA00000' / +C DATA DIVER(1), DIVER(2) / Z'FFFFFFCB', Z'3CAFFFFF' +C DATA LOG10(1), LOG10(2) / Z'509F79E9', Z'3FD34413' / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER +C +C DATA SMALL(1), SMALL(2) / O000040000000, O000000000000 / +C DATA LARGE(1), LARGE(2) / O377777777777, O777777777777 / +C DATA RIGHT(1), RIGHT(2) / O170540000000, O000000000000 / +C DATA DIVER(1), DIVER(2) / O170640000000, O000000000000 / +C DATA LOG10(1), LOG10(2) / O177746420232, O411757177572 / +C +C***FIRST EXECUTABLE STATEMENT D1MACH + IF (I .LT. 1 .OR. I .GT. 5) CALL XERMSG ('SLATEC', 'D1MACH', + + 'I OUT OF BOUNDS', 1, 2) +C + D1MACH = DMACH(I) + RETURN +C + END diff --git a/modules/nwtc-library/src/NetLib/slatec/dqk61.f b/modules/nwtc-library/src/NetLib/slatec/dqk61.f new file mode 100644 index 0000000000..16d852c8e1 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/dqk61.f @@ -0,0 +1,241 @@ +*DECK DQK61 + SUBROUTINE DQK61 (F, A, B, RESULT, ABSERR, RESABS, RESASC) +C***BEGIN PROLOGUE DQK61 +C***PURPOSE To compute I = Integral of F over (A,B) with error +C estimate +C J = Integral of ABS(F) over (A,B) +C***LIBRARY SLATEC (QUADPACK) +C***CATEGORY H2A1A2 +C***TYPE DOUBLE PRECISION (QK61-S, DQK61-D) +C***KEYWORDS 61-POINT GAUSS-KRONROD RULES, QUADPACK, QUADRATURE +C***AUTHOR Piessens, Robert +C Applied Mathematics and Programming Division +C K. U. Leuven +C de Doncker, Elise +C Applied Mathematics and Programming Division +C K. U. Leuven +C***DESCRIPTION +C +C Integration rule +C Standard fortran subroutine +C Double precision version +C +C +C PARAMETERS +C ON ENTRY +C F - Double precision +C Function subprogram defining the integrand +C function F(X). The actual name for F needs to be +C declared E X T E R N A L in the calling program. +C +C A - Double precision +C Lower limit of integration +C +C B - Double precision +C Upper limit of integration +C +C ON RETURN +C RESULT - Double precision +C Approximation to the integral I +C RESULT is computed by applying the 61-point +C Kronrod rule (RESK) obtained by optimal addition of +C abscissae to the 30-point Gauss rule (RESG). +C +C ABSERR - Double precision +C Estimate of the modulus of the absolute error, +C which should equal or exceed ABS(I-RESULT) +C +C RESABS - Double precision +C Approximation to the integral J +C +C RESASC - Double precision +C Approximation to the integral of ABS(F-I/(B-A)) +C +C***REFERENCES (NONE) +C***ROUTINES CALLED D1MACH +C***REVISION HISTORY (YYMMDD) +C 800101 DATE WRITTEN +C 890531 Changed all specific intrinsics to generic. (WRB) +C 890531 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C***END PROLOGUE DQK61 +C + DOUBLE PRECISION A,DABSC,ABSERR,B,CENTR,DHLGTH, + 1 D1MACH,EPMACH,F,FC,FSUM,FVAL1,FVAL2,FV1,FV2,HLGTH,RESABS,RESASC, + 2 RESG,RESK,RESKH,RESULT,UFLOW,WG,WGK,XGK + INTEGER J,JTW,JTWM1 + EXTERNAL F +C + DIMENSION FV1(30),FV2(30),XGK(31),WGK(31),WG(15) +C +C THE ABSCISSAE AND WEIGHTS ARE GIVEN FOR THE +C INTERVAL (-1,1). BECAUSE OF SYMMETRY ONLY THE POSITIVE +C ABSCISSAE AND THEIR CORRESPONDING WEIGHTS ARE GIVEN. +C +C XGK - ABSCISSAE OF THE 61-POINT KRONROD RULE +C XGK(2), XGK(4) ... ABSCISSAE OF THE 30-POINT +C GAUSS RULE +C XGK(1), XGK(3) ... OPTIMALLY ADDED ABSCISSAE +C TO THE 30-POINT GAUSS RULE +C +C WGK - WEIGHTS OF THE 61-POINT KRONROD RULE +C +C WG - WEIGHTS OF THE 30-POINT GAUSS RULE +C +C +C GAUSS QUADRATURE WEIGHTS AND KRONROD QUADRATURE ABSCISSAE AND WEIGHTS +C AS EVALUATED WITH 80 DECIMAL DIGIT ARITHMETIC BY L. W. FULLERTON, +C BELL LABS, NOV. 1981. +C + SAVE WG, XGK, WGK + DATA WG ( 1) / 0.0079681924 9616660561 5465883474 674 D0 / + DATA WG ( 2) / 0.0184664683 1109095914 2302131912 047 D0 / + DATA WG ( 3) / 0.0287847078 8332336934 9719179611 292 D0 / + DATA WG ( 4) / 0.0387991925 6962704959 6801936446 348 D0 / + DATA WG ( 5) / 0.0484026728 3059405290 2938140422 808 D0 / + DATA WG ( 6) / 0.0574931562 1761906648 1721689402 056 D0 / + DATA WG ( 7) / 0.0659742298 8218049512 8128515115 962 D0 / + DATA WG ( 8) / 0.0737559747 3770520626 8243850022 191 D0 / + DATA WG ( 9) / 0.0807558952 2942021535 4694938460 530 D0 / + DATA WG ( 10) / 0.0868997872 0108297980 2387530715 126 D0 / + DATA WG ( 11) / 0.0921225222 3778612871 7632707087 619 D0 / + DATA WG ( 12) / 0.0963687371 7464425963 9468626351 810 D0 / + DATA WG ( 13) / 0.0995934205 8679526706 2780282103 569 D0 / + DATA WG ( 14) / 0.1017623897 4840550459 6428952168 554 D0 / + DATA WG ( 15) / 0.1028526528 9355884034 1285636705 415 D0 / +C + DATA XGK ( 1) / 0.9994844100 5049063757 1325895705 811 D0 / + DATA XGK ( 2) / 0.9968934840 7464954027 1630050918 695 D0 / + DATA XGK ( 3) / 0.9916309968 7040459485 8628366109 486 D0 / + DATA XGK ( 4) / 0.9836681232 7974720997 0032581605 663 D0 / + DATA XGK ( 5) / 0.9731163225 0112626837 4693868423 707 D0 / + DATA XGK ( 6) / 0.9600218649 6830751221 6871025581 798 D0 / + DATA XGK ( 7) / 0.9443744447 4855997941 5831324037 439 D0 / + DATA XGK ( 8) / 0.9262000474 2927432587 9324277080 474 D0 / + DATA XGK ( 9) / 0.9055733076 9990779854 6522558925 958 D0 / + DATA XGK ( 10) / 0.8825605357 9205268154 3116462530 226 D0 / + DATA XGK ( 11) / 0.8572052335 4606109895 8658510658 944 D0 / + DATA XGK ( 12) / 0.8295657623 8276839744 2898119732 502 D0 / + DATA XGK ( 13) / 0.7997278358 2183908301 3668942322 683 D0 / + DATA XGK ( 14) / 0.7677774321 0482619491 7977340974 503 D0 / + DATA XGK ( 15) / 0.7337900624 5322680472 6171131369 528 D0 / + DATA XGK ( 16) / 0.6978504947 9331579693 2292388026 640 D0 / + DATA XGK ( 17) / 0.6600610641 2662696137 0053668149 271 D0 / + DATA XGK ( 18) / 0.6205261829 8924286114 0477556431 189 D0 / + DATA XGK ( 19) / 0.5793452358 2636169175 6024932172 540 D0 / + DATA XGK ( 20) / 0.5366241481 4201989926 4169793311 073 D0 / + DATA XGK ( 21) / 0.4924804678 6177857499 3693061207 709 D0 / + DATA XGK ( 22) / 0.4470337695 3808917678 0609900322 854 D0 / + DATA XGK ( 23) / 0.4004012548 3039439253 5476211542 661 D0 / + DATA XGK ( 24) / 0.3527047255 3087811347 1037207089 374 D0 / + DATA XGK ( 25) / 0.3040732022 7362507737 2677107199 257 D0 / + DATA XGK ( 26) / 0.2546369261 6788984643 9805129817 805 D0 / + DATA XGK ( 27) / 0.2045251166 8230989143 8957671002 025 D0 / + DATA XGK ( 28) / 0.1538699136 0858354696 3794672743 256 D0 / + DATA XGK ( 29) / 0.1028069379 6673703014 7096751318 001 D0 / + DATA XGK ( 30) / 0.0514718425 5531769583 3025213166 723 D0 / + DATA XGK ( 31) / 0.0000000000 0000000000 0000000000 000 D0 / +C + DATA WGK ( 1) / 0.0013890136 9867700762 4551591226 760 D0 / + DATA WGK ( 2) / 0.0038904611 2709988405 1267201844 516 D0 / + DATA WGK ( 3) / 0.0066307039 1593129217 3319826369 750 D0 / + DATA WGK ( 4) / 0.0092732796 5951776342 8441146892 024 D0 / + DATA WGK ( 5) / 0.0118230152 5349634174 2232898853 251 D0 / + DATA WGK ( 6) / 0.0143697295 0704580481 2451432443 580 D0 / + DATA WGK ( 7) / 0.0169208891 8905327262 7572289420 322 D0 / + DATA WGK ( 8) / 0.0194141411 9394238117 3408951050 128 D0 / + DATA WGK ( 9) / 0.0218280358 2160919229 7167485738 339 D0 / + DATA WGK ( 10) / 0.0241911620 7808060136 5686370725 232 D0 / + DATA WGK ( 11) / 0.0265099548 8233310161 0601709335 075 D0 / + DATA WGK ( 12) / 0.0287540487 6504129284 3978785354 334 D0 / + DATA WGK ( 13) / 0.0309072575 6238776247 2884252943 092 D0 / + DATA WGK ( 14) / 0.0329814470 5748372603 1814191016 854 D0 / + DATA WGK ( 15) / 0.0349793380 2806002413 7499670731 468 D0 / + DATA WGK ( 16) / 0.0368823646 5182122922 3911065617 136 D0 / + DATA WGK ( 17) / 0.0386789456 2472759295 0348651532 281 D0 / + DATA WGK ( 18) / 0.0403745389 5153595911 1995279752 468 D0 / + DATA WGK ( 19) / 0.0419698102 1516424614 7147541285 970 D0 / + DATA WGK ( 20) / 0.0434525397 0135606931 6831728117 073 D0 / + DATA WGK ( 21) / 0.0448148001 3316266319 2355551616 723 D0 / + DATA WGK ( 22) / 0.0460592382 7100698811 6271735559 374 D0 / + DATA WGK ( 23) / 0.0471855465 6929915394 5261478181 099 D0 / + DATA WGK ( 24) / 0.0481858617 5708712914 0779492298 305 D0 / + DATA WGK ( 25) / 0.0490554345 5502977888 7528165367 238 D0 / + DATA WGK ( 26) / 0.0497956834 2707420635 7811569379 942 D0 / + DATA WGK ( 27) / 0.0504059214 0278234684 0893085653 585 D0 / + DATA WGK ( 28) / 0.0508817958 9874960649 2297473049 805 D0 / + DATA WGK ( 29) / 0.0512215478 4925877217 0656282604 944 D0 / + DATA WGK ( 30) / 0.0514261285 3745902593 3862879215 781 D0 / + DATA WGK ( 31) / 0.0514947294 2945156755 8340433647 099 D0 / +C +C LIST OF MAJOR VARIABLES +C ----------------------- +C +C CENTR - MID POINT OF THE INTERVAL +C HLGTH - HALF-LENGTH OF THE INTERVAL +C DABSC - ABSCISSA +C FVAL* - FUNCTION VALUE +C RESG - RESULT OF THE 30-POINT GAUSS RULE +C RESK - RESULT OF THE 61-POINT KRONROD RULE +C RESKH - APPROXIMATION TO THE MEAN VALUE OF F +C OVER (A,B), I.E. TO I/(B-A) +C +C MACHINE DEPENDENT CONSTANTS +C --------------------------- +C +C EPMACH IS THE LARGEST RELATIVE SPACING. +C UFLOW IS THE SMALLEST POSITIVE MAGNITUDE. +C +C***FIRST EXECUTABLE STATEMENT DQK61 + EPMACH = D1MACH(4) + UFLOW = D1MACH(1) +C + CENTR = 0.5D+00*(B+A) + HLGTH = 0.5D+00*(B-A) + DHLGTH = ABS(HLGTH) +C +C COMPUTE THE 61-POINT KRONROD APPROXIMATION TO THE +C INTEGRAL, AND ESTIMATE THE ABSOLUTE ERROR. +C + RESG = 0.0D+00 + FC = F(CENTR) + RESK = WGK(31)*FC + RESABS = ABS(RESK) + DO 10 J=1,15 + JTW = J*2 + DABSC = HLGTH*XGK(JTW) + FVAL1 = F(CENTR-DABSC) + FVAL2 = F(CENTR+DABSC) + FV1(JTW) = FVAL1 + FV2(JTW) = FVAL2 + FSUM = FVAL1+FVAL2 + RESG = RESG+WG(J)*FSUM + RESK = RESK+WGK(JTW)*FSUM + RESABS = RESABS+WGK(JTW)*(ABS(FVAL1)+ABS(FVAL2)) + 10 CONTINUE + DO 15 J=1,15 + JTWM1 = J*2-1 + DABSC = HLGTH*XGK(JTWM1) + FVAL1 = F(CENTR-DABSC) + FVAL2 = F(CENTR+DABSC) + FV1(JTWM1) = FVAL1 + FV2(JTWM1) = FVAL2 + FSUM = FVAL1+FVAL2 + RESK = RESK+WGK(JTWM1)*FSUM + RESABS = RESABS+WGK(JTWM1)*(ABS(FVAL1)+ABS(FVAL2)) + 15 CONTINUE + RESKH = RESK*0.5D+00 + RESASC = WGK(31)*ABS(FC-RESKH) + DO 20 J=1,30 + RESASC = RESASC+WGK(J)*(ABS(FV1(J)-RESKH)+ABS(FV2(J)-RESKH)) + 20 CONTINUE + RESULT = RESK*HLGTH + RESABS = RESABS*DHLGTH + RESASC = RESASC*DHLGTH + ABSERR = ABS((RESK-RESG)*HLGTH) + IF(RESASC.NE.0.0D+00.AND.ABSERR.NE.0.0D+00) + 1 ABSERR = RESASC*MIN(0.1D+01,(0.2D+03*ABSERR/RESASC)**1.5D+00) + IF(RESABS.GT.UFLOW/(0.5D+02*EPMACH)) ABSERR = MAX + 1 ((EPMACH*0.5D+02)*RESABS,ABSERR) + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/fdump.f b/modules/nwtc-library/src/NetLib/slatec/fdump.f new file mode 100644 index 0000000000..1f44a57a05 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/fdump.f @@ -0,0 +1,31 @@ +*DECK FDUMP + SUBROUTINE FDUMP +C***BEGIN PROLOGUE FDUMP +C***PURPOSE Symbolic dump (should be locally written). +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3 +C***TYPE ALL (FDUMP-A) +C***KEYWORDS ERROR, XERMSG +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C ***Note*** Machine Dependent Routine +C FDUMP is intended to be replaced by a locally written +C version which produces a symbolic dump. Failing this, +C it should be replaced by a version which prints the +C subprogram nesting list. Note that this dump must be +C printed on each of up to five files, as indicated by the +C XGETUA routine. See XSETUA and XGETUA for details. +C +C Written by Ron Jones, with SLATEC Common Math Library Subcommittee +C +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C***END PROLOGUE FDUMP +C***FIRST EXECUTABLE STATEMENT FDUMP + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/i1mach.f b/modules/nwtc-library/src/NetLib/slatec/i1mach.f new file mode 100644 index 0000000000..ad04e7b083 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/i1mach.f @@ -0,0 +1,888 @@ +*DECK I1MACH + INTEGER FUNCTION I1MACH (I) +C***BEGIN PROLOGUE I1MACH +C***PURPOSE Return integer machine dependent constants. +C***LIBRARY SLATEC +C***CATEGORY R1 +C***TYPE INTEGER (I1MACH-I) +C***KEYWORDS MACHINE CONSTANTS +C***AUTHOR Fox, P. A., (Bell Labs) +C Hall, A. D., (Bell Labs) +C Schryer, N. L., (Bell Labs) +C***DESCRIPTION +C +C I1MACH can be used to obtain machine-dependent parameters for the +C local machine environment. It is a function subprogram with one +C (input) argument and can be referenced as follows: +C +C K = I1MACH(I) +C +C where I=1,...,16. The (output) value of K above is determined by +C the (input) value of I. The results for various values of I are +C discussed below. +C +C I/O unit numbers: +C I1MACH( 1) = the standard input unit. +C I1MACH( 2) = the standard output unit. +C I1MACH( 3) = the standard punch unit. +C I1MACH( 4) = the standard error message unit. +C +C Words: +C I1MACH( 5) = the number of bits per integer storage unit. +C I1MACH( 6) = the number of characters per integer storage unit. +C +C Integers: +C assume integers are represented in the S-digit, base-A form +C +C sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) +C +C where 0 .LE. X(I) .LT. A for I=0,...,S-1. +C I1MACH( 7) = A, the base. +C I1MACH( 8) = S, the number of base-A digits. +C I1MACH( 9) = A**S - 1, the largest magnitude. +C +C Floating-Point Numbers: +C Assume floating-point numbers are represented in the T-digit, +C base-B form +C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C where 0 .LE. X(I) .LT. B for I=1,...,T, +C 0 .LT. X(1), and EMIN .LE. E .LE. EMAX. +C I1MACH(10) = B, the base. +C +C Single-Precision: +C I1MACH(11) = T, the number of base-B digits. +C I1MACH(12) = EMIN, the smallest exponent E. +C I1MACH(13) = EMAX, the largest exponent E. +C +C Double-Precision: +C I1MACH(14) = T, the number of base-B digits. +C I1MACH(15) = EMIN, the smallest exponent E. +C I1MACH(16) = EMAX, the largest exponent E. +C +C To alter this function for a particular environment, the desired +C set of DATA statements should be activated by removing the C from +C column 1. Also, the values of I1MACH(1) - I1MACH(4) should be +C checked for consistency with the local operating system. +C +C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for +C a portable library, ACM Transactions on Mathematical +C Software 4, 2 (June 1978), pp. 177-188. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 750101 DATE WRITTEN +C 891012 Added VAX G-floating constants. (WRB) +C 891012 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900618 Added DEC RISC constants. (WRB) +C 900723 Added IBM RS 6000 constants. (WRB) +C 901009 Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16. +C (RWC) +C 910710 Added HP 730 constants. (SMR) +C 911114 Added Convex IEEE constants. (WRB) +C 920121 Added SUN -r8 compiler option constants. (WRB) +C 920229 Added Touchstone Delta i860 constants. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C 920625 Added Convex -p8 and -pd8 compiler option constants. +C (BKS, WRB) +C 930201 Added DEC Alpha and SGI constants. (RWC and WRB) +C 930618 Corrected I1MACH(5) for Convex -p8 and -pd8 compiler +C options. (DWL, RWC and WRB). +C***END PROLOGUE I1MACH +C + INTEGER IMACH(16),OUTPUT + SAVE IMACH + EQUIVALENCE (IMACH(4),OUTPUT) +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT COMPILER +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1022 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE APOLLO +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 129 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1025 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM +C +C DATA IMACH( 1) / 7 / +C DATA IMACH( 2) / 2 / +C DATA IMACH( 3) / 2 / +C DATA IMACH( 4) / 2 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 33 / +C DATA IMACH( 9) / Z1FFFFFFFF / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -256 / +C DATA IMACH(13) / 255 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) / -256 / +C DATA IMACH(16) / 255 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -50 / +C DATA IMACH(16) / 76 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -32754 / +C DATA IMACH(16) / 32780 / +C +C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 9223372036854775807 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -4095 / +C DATA IMACH(13) / 4094 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -4095 / +C DATA IMACH(16) / 4094 / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6LOUTPUT/ +C DATA IMACH( 5) / 60 / +C DATA IMACH( 6) / 10 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 48 / +C DATA IMACH( 9) / 00007777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -929 / +C DATA IMACH(13) / 1070 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -929 / +C DATA IMACH(16) / 1069 / +C +C MACHINE CONSTANTS FOR THE CELERITY C1260 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z'7FFFFFFF' / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1022 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fn COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fi COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -p8 COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 9223372036854775807 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 53 / +C DATA IMACH(12) / -1023 / +C DATA IMACH(13) / 1023 / +C DATA IMACH(14) / 113 / +C DATA IMACH(15) / -16383 / +C DATA IMACH(16) / 16383 / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -pd8 COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 9223372036854775807 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 53 / +C DATA IMACH(12) / -1023 / +C DATA IMACH(13) / 1023 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CRAY +C USING THE 46 BIT INTEGER COMPILER OPTION +C +C DATA IMACH( 1) / 100 / +C DATA IMACH( 2) / 101 / +C DATA IMACH( 3) / 102 / +C DATA IMACH( 4) / 101 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 46 / +C DATA IMACH( 9) / 1777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -8189 / +C DATA IMACH(13) / 8190 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -8099 / +C DATA IMACH(16) / 8190 / +C +C MACHINE CONSTANTS FOR THE CRAY +C USING THE 64 BIT INTEGER COMPILER OPTION +C +C DATA IMACH( 1) / 100 / +C DATA IMACH( 2) / 101 / +C DATA IMACH( 3) / 102 / +C DATA IMACH( 4) / 101 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 63 / +C DATA IMACH( 9) / 777777777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -8189 / +C DATA IMACH(13) / 8190 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -8099 / +C DATA IMACH(16) / 8190 / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C +C DATA IMACH( 1) / 11 / +C DATA IMACH( 2) / 12 / +C DATA IMACH( 3) / 8 / +C DATA IMACH( 4) / 10 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING G_FLOAT +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING IEEE_FLOAT +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE DEC RISC +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING D_FLOATING +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C USING G_FLOATING +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1023 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE ELXSI 6400 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 32 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1022 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE HARRIS 220 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 24 / +C DATA IMACH( 6) / 3 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 23 / +C DATA IMACH( 9) / 8388607 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 38 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 43 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 63 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HP 730 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C 3 WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 4 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 39 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C 4 WORD DOUBLE PRECISION OPTION WITH FTN4 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 4 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 55 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HP 9000 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 7 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 32 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -126 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1015 / +C DATA IMACH(16) / 1017 / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND +C THE PERKIN ELMER (INTERDATA) 7/32. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z7FFFFFFF / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 / +C +C MACHINE CONSTANTS FOR THE IBM PC +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE IBM RS 6000 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE INTEL i860 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR) +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 54 / +C DATA IMACH(15) / -101 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR) +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 62 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 32-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 16-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 5 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE SILICON GRAPHICS +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE SUN +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE SUN +C USING THE -r8 COMPILER OPTION +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 53 / +C DATA IMACH(12) / -1021 / +C DATA IMACH(13) / 1024 / +C DATA IMACH(14) / 113 / +C DATA IMACH(15) / -16381 / +C DATA IMACH(16) / 16384 / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 1 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) / -1024 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR +C +C DATA IMACH( 1) / 1 / +C DATA IMACH( 2) / 1 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 1 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C***FIRST EXECUTABLE STATEMENT I1MACH + IF (I .LT. 1 .OR. I .GT. 16) GO TO 10 +C + I1MACH = IMACH(I) + RETURN +C + 10 CONTINUE + WRITE (UNIT = OUTPUT, FMT = 9000) + 9000 FORMAT ('1ERROR 1 IN I1MACH - I OUT OF BOUNDS') +C +C CALL FDUMP +C + STOP + END diff --git a/modules/nwtc-library/src/NetLib/slatec/j4save.f b/modules/nwtc-library/src/NetLib/slatec/j4save.f new file mode 100644 index 0000000000..6ec799ba18 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/j4save.f @@ -0,0 +1,65 @@ +*DECK J4SAVE + FUNCTION J4SAVE (IWHICH, IVALUE, ISET) +C***BEGIN PROLOGUE J4SAVE +C***SUBSIDIARY +C***PURPOSE Save or recall global variables needed by error +C handling routines. +C***LIBRARY SLATEC (XERROR) +C***TYPE INTEGER (J4SAVE-I) +C***KEYWORDS ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C J4SAVE saves and recalls several global variables needed +C by the library error handling routines. +C +C Description of Parameters +C --Input-- +C IWHICH - Index of item desired. +C = 1 Refers to current error number. +C = 2 Refers to current error control flag. +C = 3 Refers to current unit number to which error +C messages are to be sent. (0 means use standard.) +C = 4 Refers to the maximum number of times any +C message is to be printed (as set by XERMAX). +C = 5 Refers to the total number of units to which +C each error message is to be written. +C = 6 Refers to the 2nd unit for error messages +C = 7 Refers to the 3rd unit for error messages +C = 8 Refers to the 4th unit for error messages +C = 9 Refers to the 5th unit for error messages +C IVALUE - The value to be set for the IWHICH-th parameter, +C if ISET is .TRUE. . +C ISET - If ISET=.TRUE., the IWHICH-th parameter will BE +C given the value, IVALUE. If ISET=.FALSE., the +C IWHICH-th parameter will be unchanged, and IVALUE +C is a dummy parameter. +C --Output-- +C The (old) value of the IWHICH-th parameter will be returned +C in the function value, J4SAVE. +C +C***SEE ALSO XERMSG +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900205 Minor modifications to prologue. (WRB) +C 900402 Added TYPE section. (WRB) +C 910411 Added KEYWORDS section. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE J4SAVE + LOGICAL ISET + INTEGER IPARAM(9) + SAVE IPARAM + DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/ + DATA IPARAM(5)/1/ + DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/ +C***FIRST EXECUTABLE STATEMENT J4SAVE + J4SAVE = IPARAM(IWHICH) + IF (ISET) IPARAM(IWHICH) = IVALUE + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/qk61.f b/modules/nwtc-library/src/NetLib/slatec/qk61.f new file mode 100644 index 0000000000..c1691262f3 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/qk61.f @@ -0,0 +1,202 @@ + subroutine qk61(f,a,b,result,abserr,resabs,resasc) +c***begin prologue qk61 +c***date written 800101 (yymmdd) +c***revision date 830518 (yymmdd) +c***category no. h2a1a2 +c***keywords 61-point gauss-kronrod rules +c***author piessens,robert,appl. math. & progr. div. - k.u.leuven +c de doncker,elise,appl. math. & progr. div. - k.u.leuven +c***purpose to compute i = integral of f over (a,b) with error +c estimate +c j = integral of dabs(f) over (a,b) +c***description +c +c integration rule +c standard fortran subroutine +c real version +c +c +c parameters +c on entry +c f - real +c function subprogram defining the integrand +c function f(x). the actual name for f needs to be +c declared e x t e r n a l in the calling program. +c +c a - real +c lower limit of integration +c +c b - real +c upper limit of integration +c +c on return +c result - real +c approximation to the integral i +c result is computed by applying the 61-point +c kronrod rule (resk) obtained by optimal addition of +c abscissae to the 30-point gauss rule (resg). +c +c abserr - real +c estimate of the modulus of the absolute error, +c which should equal or exceed dabs(i-result) +c +c resabs - real +c approximation to the integral j +c +c resasc - real +c approximation to the integral of dabs(f-i/(b-a)) +c +c +c***references (none) +c***routines called r1mach +c***end prologue qk61 +c + real a,absc,abserr,b,centr,dhlgth,epmach,f,fc,fsum,fval1,fval2, + * fv1,fv2,hlgth,resabs,resasc,resg,resk,reskh,result,r1mach,uflow, + * wg,wgk,xgk + integer j,jtw,jtwm1 + external f +c + dimension fv1(30),fv2(30),xgk(31),wgk(31),wg(15) +c +c the abscissae and weights are given for the +c interval (-1,1). because of symmetry only the positive +c abscissae and their corresponding weights are given. +c +c xgk - abscissae of the 61-point kronrod rule +c xgk(2), xgk(4) ... abscissae of the 30-point +c gauss rule +c xgk(1), xgk(3) ... optimally added abscissae +c to the 30-point gauss rule +c +c wgk - weights of the 61-point kronrod rule +c +c wg - weigths of the 30-point gauss rule +c + data xgk(1),xgk(2),xgk(3),xgk(4),xgk(5),xgk(6),xgk(7),xgk(8), + * xgk(9),xgk(10)/ + * 0.9994844100504906e+00, 0.9968934840746495e+00, + * 0.9916309968704046e+00, 0.9836681232797472e+00, + * 0.9731163225011263e+00, 0.9600218649683075e+00, + * 0.9443744447485600e+00, 0.9262000474292743e+00, + * 0.9055733076999078e+00, 0.8825605357920527e+00/ + data xgk(11),xgk(12),xgk(13),xgk(14),xgk(15),xgk(16), + * xgk(17),xgk(18),xgk(19),xgk(20)/ + * 0.8572052335460611e+00, 0.8295657623827684e+00, + * 0.7997278358218391e+00, 0.7677774321048262e+00, + * 0.7337900624532268e+00, 0.6978504947933158e+00, + * 0.6600610641266270e+00, 0.6205261829892429e+00, + * 0.5793452358263617e+00, 0.5366241481420199e+00/ + data xgk(21),xgk(22),xgk(23),xgk(24), + * xgk(25),xgk(26),xgk(27),xgk(28),xgk(29),xgk(30),xgk(31)/ + * 0.4924804678617786e+00, 0.4470337695380892e+00, + * 0.4004012548303944e+00, 0.3527047255308781e+00, + * 0.3040732022736251e+00, 0.2546369261678898e+00, + * 0.2045251166823099e+00, 0.1538699136085835e+00, + * 0.1028069379667370e+00, 0.5147184255531770e-01, + * 0.0e+00 / + data wgk(1),wgk(2),wgk(3),wgk(4),wgk(5),wgk(6),wgk(7),wgk(8), + * wgk(9),wgk(10)/ + * 0.1389013698677008e-02, 0.3890461127099884e-02, + * 0.6630703915931292e-02, 0.9273279659517763e-02, + * 0.1182301525349634e-01, 0.1436972950704580e-01, + * 0.1692088918905327e-01, 0.1941414119394238e-01, + * 0.2182803582160919e-01, 0.2419116207808060e-01/ + data wgk(11),wgk(12),wgk(13),wgk(14),wgk(15),wgk(16), + * wgk(17),wgk(18),wgk(19),wgk(20)/ + * 0.2650995488233310e-01, 0.2875404876504129e-01, + * 0.3090725756238776e-01, 0.3298144705748373e-01, + * 0.3497933802806002e-01, 0.3688236465182123e-01, + * 0.3867894562472759e-01, 0.4037453895153596e-01, + * 0.4196981021516425e-01, 0.4345253970135607e-01/ + data wgk(21),wgk(22),wgk(23),wgk(24), + * wgk(25),wgk(26),wgk(27),wgk(28),wgk(29),wgk(30),wgk(31)/ + * 0.4481480013316266e-01, 0.4605923827100699e-01, + * 0.4718554656929915e-01, 0.4818586175708713e-01, + * 0.4905543455502978e-01, 0.4979568342707421e-01, + * 0.5040592140278235e-01, 0.5088179589874961e-01, + * 0.5122154784925877e-01, 0.5142612853745903e-01, + * 0.5149472942945157e-01/ + data wg(1),wg(2),wg(3),wg(4),wg(5),wg(6),wg(7),wg(8)/ + * 0.7968192496166606e-02, 0.1846646831109096e-01, + * 0.2878470788332337e-01, 0.3879919256962705e-01, + * 0.4840267283059405e-01, 0.5749315621761907e-01, + * 0.6597422988218050e-01, 0.7375597473770521e-01/ + data wg(9),wg(10),wg(11),wg(12),wg(13),wg(14),wg(15)/ + * 0.8075589522942022e-01, 0.8689978720108298e-01, + * 0.9212252223778613e-01, 0.9636873717464426e-01, + * 0.9959342058679527e-01, 0.1017623897484055e+00, + * 0.1028526528935588e+00/ +c +c list of major variables +c ----------------------- +c +c centr - mid point of the interval +c hlgth - half-length of the interval +c absc - abscissa +c fval* - function value +c resg - result of the 30-point gauss rule +c resk - result of the 61-point kronrod rule +c reskh - approximation to the mean value of f +c over (a,b), i.e. to i/(b-a) +c +c machine dependent constants +c --------------------------- +c +c epmach is the largest relative spacing. +c uflow is the smallest positive magnitude. +c +c***first executable statement qk61 + epmach = r1mach(4) + uflow = r1mach(1) +c + centr = 0.5e+00*(b+a) + hlgth = 0.5e+00*(b-a) + dhlgth = abs(hlgth) +c +c compute the 61-point kronrod approximation to the +c integral, and estimate the absolute error. +c + resg = 0.0e+00 + fc = f(centr) + resk = wgk(31)*fc + resabs = abs(resk) + do 10 j=1,15 + jtw = j*2 + absc = hlgth*xgk(jtw) + fval1 = f(centr-absc) + fval2 = f(centr+absc) + fv1(jtw) = fval1 + fv2(jtw) = fval2 + fsum = fval1+fval2 + resg = resg+wg(j)*fsum + resk = resk+wgk(jtw)*fsum + resabs = resabs+wgk(jtw)*(abs(fval1)+abs(fval2)) + 10 continue + do 15 j=1,15 + jtwm1 = j*2-1 + absc = hlgth*xgk(jtwm1) + fval1 = f(centr-absc) + fval2 = f(centr+absc) + fv1(jtwm1) = fval1 + fv2(jtwm1) = fval2 + fsum = fval1+fval2 + resk = resk+wgk(jtwm1)*fsum + resabs = resabs+wgk(jtwm1)*(abs(fval1)+abs(fval2)) + 15 continue + reskh = resk*0.5e+00 + resasc = wgk(31)*abs(fc-reskh) + do 20 j=1,30 + resasc = resasc+wgk(j)*(abs(fv1(j)-reskh)+abs(fv2(j)-reskh)) + 20 continue + result = resk*hlgth + resabs = resabs*dhlgth + resasc = resasc*dhlgth + abserr = abs((resk-resg)*hlgth) + if(resasc.ne.0.0e+00.and.abserr.ne.0.0e+00) + * abserr = resasc*amin1(0.1e+01, + * (0.2e+03*abserr/resasc)**1.5e+00) + if(resabs.gt.uflow/(0.5e+02*epmach)) abserr = amax1 + * ((epmach*0.5e+02)*resabs,abserr) + return + end diff --git a/modules/nwtc-library/src/NetLib/slatec/r1mach.f b/modules/nwtc-library/src/NetLib/slatec/r1mach.f new file mode 100644 index 0000000000..43bc45179d --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/r1mach.f @@ -0,0 +1,419 @@ +*DECK R1MACH + REAL FUNCTION R1MACH (I) +C***BEGIN PROLOGUE R1MACH +C***PURPOSE Return floating point machine dependent constants. +C***LIBRARY SLATEC +C***CATEGORY R1 +C***TYPE SINGLE PRECISION (R1MACH-S, D1MACH-D) +C***KEYWORDS MACHINE CONSTANTS +C***AUTHOR Fox, P. A., (Bell Labs) +C Hall, A. D., (Bell Labs) +C Schryer, N. L., (Bell Labs) +C***DESCRIPTION +C +C R1MACH can be used to obtain machine-dependent parameters for the +C local machine environment. It is a function subprogram with one +C (input) argument, and can be referenced as follows: +C +C A = R1MACH(I) +C +C where I=1,...,5. The (output) value of A above is determined by +C the (input) value of I. The results for various values of I are +C discussed below. +C +C R1MACH(1) = B**(EMIN-1), the smallest positive magnitude. +C R1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude. +C R1MACH(3) = B**(-T), the smallest relative spacing. +C R1MACH(4) = B**(1-T), the largest relative spacing. +C R1MACH(5) = LOG10(B) +C +C Assume single precision numbers are represented in the T-digit, +C base-B form +C +C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and +C EMIN .LE. E .LE. EMAX. +C +C The values of B, T, EMIN and EMAX are provided in I1MACH as +C follows: +C I1MACH(10) = B, the base. +C I1MACH(11) = T, the number of base-B digits. +C I1MACH(12) = EMIN, the smallest exponent E. +C I1MACH(13) = EMAX, the largest exponent E. +C +C To alter this function for a particular environment, the desired +C set of DATA statements should be activated by removing the C from +C column 1. Also, the values of R1MACH(1) - R1MACH(4) should be +C checked for consistency with the local operating system. +C +C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for +C a portable library, ACM Transactions on Mathematical +C Software 4, 2 (June 1978), pp. 177-188. +C***ROUTINES CALLED XERMSG +C***REVISION HISTORY (YYMMDD) +C 790101 DATE WRITTEN +C 890213 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) +C 900618 Added DEC RISC constants. (WRB) +C 900723 Added IBM RS 6000 constants. (WRB) +C 910710 Added HP 730 constants. (SMR) +C 911114 Added Convex IEEE constants. (WRB) +C 920121 Added SUN -r8 compiler option constants. (WRB) +C 920229 Added Touchstone Delta i860 constants. (WRB) +C 920501 Reformatted the REFERENCES section. (WRB) +C 920625 Added CONVEX -p8 and -pd8 compiler option constants. +C (BKS, WRB) +C 930201 Added DEC Alpha and SGI constants. (RWC and WRB) +C***END PROLOGUE R1MACH +C + INTEGER SMALL(2) + INTEGER LARGE(2) + INTEGER RIGHT(2) + INTEGER DIVER(2) + INTEGER LOG10(2) +C + REAL RMACH(5) + SAVE RMACH +C + EQUIVALENCE (RMACH(1),SMALL(1)) + EQUIVALENCE (RMACH(2),LARGE(1)) + EQUIVALENCE (RMACH(3),RIGHT(1)) + EQUIVALENCE (RMACH(4),DIVER(1)) + EQUIVALENCE (RMACH(5),LOG10(1)) +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION +C +C DATA SMALL(1) / Z'00800000' / +C DATA LARGE(1) / Z'7F7FFFFF' / +C DATA RIGHT(1) / Z'33800000' / +C DATA DIVER(1) / Z'34000000' / +C DATA LOG10(1) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE AMIGA +C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT +C +C DATA SMALL(1) / Z'00800000' / +C DATA LARGE(1) / Z'7EFFFFFF' / +C DATA RIGHT(1) / Z'33800000' / +C DATA DIVER(1) / Z'34000000' / +C DATA LOG10(1) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE APOLLO +C +C DATA SMALL(1) / 16#00800000 / +C DATA LARGE(1) / 16#7FFFFFFF / +C DATA RIGHT(1) / 16#33800000 / +C DATA DIVER(1) / 16#34000000 / +C DATA LOG10(1) / 16#3E9A209B / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM +C +C DATA RMACH(1) / Z400800000 / +C DATA RMACH(2) / Z5FFFFFFFF / +C DATA RMACH(3) / Z4E9800000 / +C DATA RMACH(4) / Z4EA800000 / +C DATA RMACH(5) / Z500E730E8 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700/6700/7700 SYSTEMS +C +C DATA RMACH(1) / O1771000000000000 / +C DATA RMACH(2) / O0777777777777777 / +C DATA RMACH(3) / O1311000000000000 / +C DATA RMACH(4) / O1301000000000000 / +C DATA RMACH(5) / O1157163034761675 / +C +C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE +C +C DATA RMACH(1) / Z"3001800000000000" / +C DATA RMACH(2) / Z"4FFEFFFFFFFFFFFE" / +C DATA RMACH(3) / Z"3FD2800000000000" / +C DATA RMACH(4) / Z"3FD3800000000000" / +C DATA RMACH(5) / Z"3FFF9A209A84FBCF" / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES +C +C DATA RMACH(1) / 00564000000000000000B / +C DATA RMACH(2) / 37767777777777777776B / +C DATA RMACH(3) / 16414000000000000000B / +C DATA RMACH(4) / 16424000000000000000B / +C DATA RMACH(5) / 17164642023241175720B / +C +C MACHINE CONSTANTS FOR THE CELERITY C1260 +C +C DATA SMALL(1) / Z'00800000' / +C DATA LARGE(1) / Z'7F7FFFFF' / +C DATA RIGHT(1) / Z'33800000' / +C DATA DIVER(1) / Z'34000000' / +C DATA LOG10(1) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fn COMPILER OPTION +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7FFFFFFF' / +C DATA RMACH(3) / Z'34800000' / +C DATA RMACH(4) / Z'35000000' / +C DATA RMACH(5) / Z'3F9A209B' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -fi COMPILER OPTION +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE CONVEX +C USING THE -p8 OR -pd8 COMPILER OPTION +C +C DATA RMACH(1) / Z'0010000000000000' / +C DATA RMACH(2) / Z'7FFFFFFFFFFFFFFF' / +C DATA RMACH(3) / Z'3CC0000000000000' / +C DATA RMACH(4) / Z'3CD0000000000000' / +C DATA RMACH(5) / Z'3FF34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE CRAY +C +C DATA RMACH(1) / 200034000000000000000B / +C DATA RMACH(2) / 577767777777777777776B / +C DATA RMACH(3) / 377224000000000000000B / +C DATA RMACH(4) / 377234000000000000000B / +C DATA RMACH(5) / 377774642023241175720B / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - +C STATIC RMACH(5) +C +C DATA SMALL / 20K, 0 / +C DATA LARGE / 77777K, 177777K / +C DATA RIGHT / 35420K, 0 / +C DATA DIVER / 36020K, 0 / +C DATA LOG10 / 40423K, 42023K / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING G_FLOAT +C +C DATA RMACH(1) / '00000080'X / +C DATA RMACH(2) / 'FFFF7FFF'X / +C DATA RMACH(3) / '00003480'X / +C DATA RMACH(4) / '00003500'X / +C DATA RMACH(5) / '209B3F9A'X / +C +C MACHINE CONSTANTS FOR THE DEC ALPHA +C USING IEEE_FLOAT +C +C DATA RMACH(1) / '00800000'X / +C DATA RMACH(2) / '7F7FFFFF'X / +C DATA RMACH(3) / '33800000'X / +C DATA RMACH(4) / '34000000'X / +C DATA RMACH(5) / '3E9A209B'X / +C +C MACHINE CONSTANTS FOR THE DEC RISC +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE DEC VAX +C (EXPRESSED IN INTEGER AND HEXADECIMAL) +C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS +C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS +C +C DATA SMALL(1) / 128 / +C DATA LARGE(1) / -32769 / +C DATA RIGHT(1) / 13440 / +C DATA DIVER(1) / 13568 / +C DATA LOG10(1) / 547045274 / +C +C DATA SMALL(1) / Z00000080 / +C DATA LARGE(1) / ZFFFF7FFF / +C DATA RIGHT(1) / Z00003480 / +C DATA DIVER(1) / Z00003500 / +C DATA LOG10(1) / Z209B3F9A / +C +C MACHINE CONSTANTS FOR THE ELXSI 6400 +C (ASSUMING REAL*4 IS THE DEFAULT REAL) +C +C DATA SMALL(1) / '00800000'X / +C DATA LARGE(1) / '7F7FFFFF'X / +C DATA RIGHT(1) / '33800000'X / +C DATA DIVER(1) / '34000000'X / +C DATA LOG10(1) / '3E9A209B'X / +C +C MACHINE CONSTANTS FOR THE HARRIS 220 +C +C DATA SMALL(1), SMALL(2) / '20000000, '00000201 / +C DATA LARGE(1), LARGE(2) / '37777777, '00000177 / +C DATA RIGHT(1), RIGHT(2) / '20000000, '00000352 / +C DATA DIVER(1), DIVER(2) / '20000000, '00000353 / +C DATA LOG10(1), LOG10(2) / '23210115, '00000377 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES +C +C DATA RMACH(1) / O402400000000 / +C DATA RMACH(2) / O376777777777 / +C DATA RMACH(3) / O714400000000 / +C DATA RMACH(4) / O716400000000 / +C DATA RMACH(5) / O776464202324 / +C +C MACHINE CONSTANTS FOR THE HP 730 +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C 3 WORD DOUBLE PRECISION WITH FTN4 +C +C DATA SMALL(1), SMALL(2) / 40000B, 1 / +C DATA LARGE(1), LARGE(2) / 77777B, 177776B / +C DATA RIGHT(1), RIGHT(2) / 40000B, 325B / +C DATA DIVER(1), DIVER(2) / 40000B, 327B / +C DATA LOG10(1), LOG10(2) / 46420B, 46777B / +C +C MACHINE CONSTANTS FOR THE HP 2100 +C 4 WORD DOUBLE PRECISION WITH FTN4 +C +C DATA SMALL(1), SMALL(2) / 40000B, 1 / +C DATA LARGE(1), LARGE(2) / 77777B, 177776B / +C DATA RIGHT(1), RIGHT(2) / 40000B, 325B / +C DATA DIVER(1), DIVER(2) / 40000B, 327B / +C DATA LOG10(1), LOG10(2) / 46420B, 46777B / +C +C MACHINE CONSTANTS FOR THE HP 9000 +C +C DATA SMALL(1) / 00004000000B / +C DATA LARGE(1) / 17677777777B / +C DATA RIGHT(1) / 06340000000B / +C DATA DIVER(1) / 06400000000B / +C DATA LOG10(1) / 07646420233B / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86 AND +C THE PERKIN ELMER (INTERDATA) 7/32. +C +C DATA RMACH(1) / Z00100000 / +C DATA RMACH(2) / Z7FFFFFFF / +C DATA RMACH(3) / Z3B100000 / +C DATA RMACH(4) / Z3C100000 / +C DATA RMACH(5) / Z41134413 / +C +C MACHINE CONSTANTS FOR THE IBM PC +C +C DATA SMALL(1) / 1.18E-38 / +C DATA LARGE(1) / 3.40E+38 / +C DATA RIGHT(1) / 0.595E-07 / +C DATA DIVER(1) / 1.19E-07 / +C DATA LOG10(1) / 0.30102999566 / +C +C MACHINE CONSTANTS FOR THE IBM RS 6000 +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE INTEL i860 +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA OR KI PROCESSOR) +C +C DATA RMACH(1) / "000400000000 / +C DATA RMACH(2) / "377777777777 / +C DATA RMACH(3) / "146400000000 / +C DATA RMACH(4) / "147400000000 / +C DATA RMACH(5) / "177464202324 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1) / 8388608 / +C DATA LARGE(1) / 2147483647 / +C DATA RIGHT(1) / 880803840 / +C DATA DIVER(1) / 889192448 / +C DATA LOG10(1) / 1067065499 / +C +C DATA RMACH(1) / O00040000000 / +C DATA RMACH(2) / O17777777777 / +C DATA RMACH(3) / O06440000000 / +C DATA RMACH(4) / O06500000000 / +C DATA RMACH(5) / O07746420233 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING +C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1), SMALL(2) / 128, 0 / +C DATA LARGE(1), LARGE(2) / 32767, -1 / +C DATA RIGHT(1), RIGHT(2) / 13440, 0 / +C DATA DIVER(1), DIVER(2) / 13568, 0 / +C DATA LOG10(1), LOG10(2) / 16282, 8347 / +C +C DATA SMALL(1), SMALL(2) / O000200, O000000 / +C DATA LARGE(1), LARGE(2) / O077777, O177777 / +C DATA RIGHT(1), RIGHT(2) / O032200, O000000 / +C DATA DIVER(1), DIVER(2) / O032400, O000000 / +C DATA LOG10(1), LOG10(2) / O037632, O020233 / +C +C MACHINE CONSTANTS FOR THE SILICON GRAPHICS +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE SUN +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C MACHINE CONSTANTS FOR THE SUN +C USING THE -r8 COMPILER OPTION +C +C DATA RMACH(1) / Z'0010000000000000' / +C DATA RMACH(2) / Z'7FEFFFFFFFFFFFFF' / +C DATA RMACH(3) / Z'3CA0000000000000' / +C DATA RMACH(4) / Z'3CB0000000000000' / +C DATA RMACH(5) / Z'3FD34413509F79FF' / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES +C +C DATA RMACH(1) / O000400000000 / +C DATA RMACH(2) / O377777777777 / +C DATA RMACH(3) / O146400000000 / +C DATA RMACH(4) / O147400000000 / +C DATA RMACH(5) / O177464202324 / +C +C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR +C +C DATA SMALL(1), SMALL(2) / 0, 256/ +C DATA LARGE(1), LARGE(2) / -1, -129/ +C DATA RIGHT(1), RIGHT(2) / 0, 26880/ +C DATA DIVER(1), DIVER(2) / 0, 27136/ +C DATA LOG10(1), LOG10(2) / 8347, 32538/ +C +C***FIRST EXECUTABLE STATEMENT R1MACH + IF (I .LT. 1 .OR. I .GT. 5) CALL XERMSG ('SLATEC', 'R1MACH', + + 'I OUT OF BOUNDS', 1, 2) +C + R1MACH = RMACH(I) + RETURN +C + END diff --git a/modules/nwtc-library/src/NetLib/slatec/xercnt.f b/modules/nwtc-library/src/NetLib/slatec/xercnt.f new file mode 100644 index 0000000000..06c82ab182 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/xercnt.f @@ -0,0 +1,60 @@ +*DECK XERCNT + SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL) +C***BEGIN PROLOGUE XERCNT +C***SUBSIDIARY +C***PURPOSE Allow user control over handling of errors. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERCNT-A) +C***KEYWORDS ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C Allows user control over handling of individual errors. +C Just after each message is recorded, but before it is +C processed any further (i.e., before it is printed or +C a decision to abort is made), a call is made to XERCNT. +C If the user has provided his own version of XERCNT, he +C can then override the value of KONTROL used in processing +C this message by redefining its value. +C KONTRL may be set to any value from -2 to 2. +C The meanings for KONTRL are the same as in XSETF, except +C that the value of KONTRL changes only for this message. +C If KONTRL is set to a value outside the range from -2 to 2, +C it will be moved back into that range. +C +C Description of Parameters +C +C --Input-- +C LIBRAR - the library that the routine is in. +C SUBROU - the subroutine that XERMSG is being called from +C MESSG - the first 20 characters of the error message. +C NERR - same as in the call to XERMSG. +C LEVEL - same as in the call to XERMSG. +C KONTRL - the current value of the control flag as set +C by a call to XSETF. +C +C --Output-- +C KONTRL - the new value of KONTRL. If KONTRL is not +C defined, it will remain at its original value. +C This changed value of control affects only +C the current occurrence of the current message. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900206 Routine changed from user-callable to subsidiary. (WRB) +C 900510 Changed calling sequence to include LIBRARY and SUBROUTINE +C names, changed routine name from XERCTL to XERCNT. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERCNT + CHARACTER*(*) LIBRAR, SUBROU, MESSG +C***FIRST EXECUTABLE STATEMENT XERCNT + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/xerhlt.f b/modules/nwtc-library/src/NetLib/slatec/xerhlt.f new file mode 100644 index 0000000000..89b2a77090 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/xerhlt.f @@ -0,0 +1,39 @@ +*DECK XERHLT + SUBROUTINE XERHLT (MESSG) +C***BEGIN PROLOGUE XERHLT +C***SUBSIDIARY +C***PURPOSE Abort program execution and print error message. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERHLT-A) +C***KEYWORDS ABORT PROGRAM EXECUTION, ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C ***Note*** machine dependent routine +C XERHLT aborts the execution of the program. +C The error message causing the abort is given in the calling +C sequence, in case one needs it for printing on a dayfile, +C for example. +C +C Description of Parameters +C MESSG is as in XERMSG. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900206 Routine changed from user-callable to subsidiary. (WRB) +C 900510 Changed calling sequence to delete length of character +C and changed routine name from XERABT to XERHLT. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERHLT + CHARACTER*(*) MESSG +C***FIRST EXECUTABLE STATEMENT XERHLT + STOP + END diff --git a/modules/nwtc-library/src/NetLib/slatec/xermsg.f b/modules/nwtc-library/src/NetLib/slatec/xermsg.f new file mode 100644 index 0000000000..46c83ec07a --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/xermsg.f @@ -0,0 +1,364 @@ +*DECK XERMSG + SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL) +C***BEGIN PROLOGUE XERMSG +C***PURPOSE Process error messages for SLATEC and other libraries. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERMSG-A) +C***KEYWORDS ERROR MESSAGE, XERROR +C***AUTHOR Fong, Kirby, (NMFECC at LLNL) +C***DESCRIPTION +C +C XERMSG processes a diagnostic message in a manner determined by the +C value of LEVEL and the current value of the library error control +C flag, KONTRL. See subroutine XSETF for details. +C +C LIBRAR A character constant (or character variable) with the name +C of the library. This will be 'SLATEC' for the SLATEC +C Common Math Library. The error handling package is +C general enough to be used by many libraries +C simultaneously, so it is desirable for the routine that +C detects and reports an error to identify the library name +C as well as the routine name. +C +C SUBROU A character constant (or character variable) with the name +C of the routine that detected the error. Usually it is the +C name of the routine that is calling XERMSG. There are +C some instances where a user callable library routine calls +C lower level subsidiary routines where the error is +C detected. In such cases it may be more informative to +C supply the name of the routine the user called rather than +C the name of the subsidiary routine that detected the +C error. +C +C MESSG A character constant (or character variable) with the text +C of the error or warning message. In the example below, +C the message is a character constant that contains a +C generic message. +C +C CALL XERMSG ('SLATEC', 'MMPY', +C *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION', +C *3, 1) +C +C It is possible (and is sometimes desirable) to generate a +C specific message--e.g., one that contains actual numeric +C values. Specific numeric values can be converted into +C character strings using formatted WRITE statements into +C character variables. This is called standard Fortran +C internal file I/O and is exemplified in the first three +C lines of the following example. You can also catenate +C substrings of characters to construct the error message. +C Here is an example showing the use of both writing to +C an internal file and catenating character strings. +C +C CHARACTER*5 CHARN, CHARL +C WRITE (CHARN,10) N +C WRITE (CHARL,10) LDA +C 10 FORMAT(I5) +C CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN// +C * ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'// +C * CHARL, 3, 1) +C +C There are two subtleties worth mentioning. One is that +C the // for character catenation is used to construct the +C error message so that no single character constant is +C continued to the next line. This avoids confusion as to +C whether there are trailing blanks at the end of the line. +C The second is that by catenating the parts of the message +C as an actual argument rather than encoding the entire +C message into one large character variable, we avoid +C having to know how long the message will be in order to +C declare an adequate length for that large character +C variable. XERMSG calls XERPRN to print the message using +C multiple lines if necessary. If the message is very long, +C XERPRN will break it into pieces of 72 characters (as +C requested by XERMSG) for printing on multiple lines. +C Also, XERMSG asks XERPRN to prefix each line with ' * ' +C so that the total line length could be 76 characters. +C Note also that XERPRN scans the error message backwards +C to ignore trailing blanks. Another feature is that +C the substring '$$' is treated as a new line sentinel +C by XERPRN. If you want to construct a multiline +C message without having to count out multiples of 72 +C characters, just use '$$' as a separator. '$$' +C obviously must occur within 72 characters of the +C start of each line to have its intended effect since +C XERPRN is asked to wrap around at 72 characters in +C addition to looking for '$$'. +C +C NERR An integer value that is chosen by the library routine's +C author. It must be in the range -99 to 999 (three +C printable digits). Each distinct error should have its +C own error number. These error numbers should be described +C in the machine readable documentation for the routine. +C The error numbers need be unique only within each routine, +C so it is reasonable for each routine to start enumerating +C errors from 1 and proceeding to the next integer. +C +C LEVEL An integer value in the range 0 to 2 that indicates the +C level (severity) of the error. Their meanings are +C +C -1 A warning message. This is used if it is not clear +C that there really is an error, but the user's attention +C may be needed. An attempt is made to only print this +C message once. +C +C 0 A warning message. This is used if it is not clear +C that there really is an error, but the user's attention +C may be needed. +C +C 1 A recoverable error. This is used even if the error is +C so serious that the routine cannot return any useful +C answer. If the user has told the error package to +C return after recoverable errors, then XERMSG will +C return to the Library routine which can then return to +C the user's routine. The user may also permit the error +C package to terminate the program upon encountering a +C recoverable error. +C +C 2 A fatal error. XERMSG will not return to its caller +C after it receives a fatal error. This level should +C hardly ever be used; it is much better to allow the +C user a chance to recover. An example of one of the few +C cases in which it is permissible to declare a level 2 +C error is a reverse communication Library routine that +C is likely to be called repeatedly until it integrates +C across some interval. If there is a serious error in +C the input such that another step cannot be taken and +C the Library routine is called again without the input +C error having been corrected by the caller, the Library +C routine will probably be called forever with improper +C input. In this case, it is reasonable to declare the +C error to be fatal. +C +C Each of the arguments to XERMSG is input; none will be modified by +C XERMSG. A routine may make multiple calls to XERMSG with warning +C level messages; however, after a call to XERMSG with a recoverable +C error, the routine should return to the user. Do not try to call +C XERMSG with a second recoverable error after the first recoverable +C error because the error package saves the error number. The user +C can retrieve this error number by calling another entry point in +C the error handling package and then clear the error number when +C recovering from the error. Calling XERMSG in succession causes the +C old error number to be overwritten by the latest error number. +C This is considered harmless for error numbers associated with +C warning messages but must not be done for error numbers of serious +C errors. After a call to XERMSG with a recoverable error, the user +C must be given a chance to call NUMXER or XERCLR to retrieve or +C clear the error number. +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE +C***REVISION HISTORY (YYMMDD) +C 880101 DATE WRITTEN +C 880621 REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988. +C THERE ARE TWO BASIC CHANGES. +C 1. A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO +C PRINT MESSAGES. THIS ROUTINE WILL BREAK LONG MESSAGES +C INTO PIECES FOR PRINTING ON MULTIPLE LINES. '$$' IS +C ACCEPTED AS A NEW LINE SENTINEL. A PREFIX CAN BE +C ADDED TO EACH LINE TO BE PRINTED. XERMSG USES EITHER +C ' ***' OR ' * ' AND LONG MESSAGES ARE BROKEN EVERY +C 72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE +C LENGTH OUTPUT CAN NOW BE AS GREAT AS 76. +C 2. THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE +C FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE +C OF LOWER CASE. +C 880708 REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30. +C THE PRINCIPAL CHANGES ARE +C 1. CLARIFY COMMENTS IN THE PROLOGUES +C 2. RENAME XRPRNT TO XERPRN +C 3. REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES +C SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE / +C CHARACTER FOR NEW RECORDS. +C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO +C CLEAN UP THE CODING. +C 890721 REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN +C PREFIX. +C 891013 REVISED TO CORRECT COMMENTS. +C 891214 Prologue converted to Version 4.0 format. (WRB) +C 900510 Changed test on NERR to be -9999999 < NERR < 99999999, but +C NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3. Added +C LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and +C XERCTL to XERCNT. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERMSG + CHARACTER*(*) LIBRAR, SUBROU, MESSG + CHARACTER*8 XLIBR, XSUBR + CHARACTER*72 TEMP + CHARACTER*20 LFIRST +C***FIRST EXECUTABLE STATEMENT XERMSG + LKNTRL = J4SAVE (2, 0, .FALSE.) + MAXMES = J4SAVE (4, 0, .FALSE.) +C +C LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL. +C MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE +C SHOULD BE PRINTED. +C +C WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN +C CALLING XERMSG. THE ERROR NUMBER SHOULD BE POSITIVE, +C AND THE LEVEL SHOULD BE BETWEEN 0 AND 2. +C + IF (NERR.LT.-9999999 .OR. NERR.GT.99999999 .OR. NERR.EQ.0 .OR. + * LEVEL.LT.-1 .OR. LEVEL.GT.2) THEN + CALL XERPRN (' ***', -1, 'FATAL ERROR IN...$$ ' // + * 'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '// + * 'JOB ABORT DUE TO FATAL ERROR.', 72) + CALL XERSVE (' ', ' ', ' ', 0, 0, 0, KDUMMY) + CALL XERHLT (' ***XERMSG -- INVALID INPUT') + RETURN + ENDIF +C +C RECORD THE MESSAGE. +C + I = J4SAVE (1, NERR, .TRUE.) + CALL XERSVE (LIBRAR, SUBROU, MESSG, 1, NERR, LEVEL, KOUNT) +C +C HANDLE PRINT-ONCE WARNING MESSAGES. +C + IF (LEVEL.EQ.-1 .AND. KOUNT.GT.1) RETURN +C +C ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG. +C + XLIBR = LIBRAR + XSUBR = SUBROU + LFIRST = MESSG + LERR = NERR + LLEVEL = LEVEL + CALL XERCNT (XLIBR, XSUBR, LFIRST, LERR, LLEVEL, LKNTRL) +C + LKNTRL = MAX(-2, MIN(2,LKNTRL)) + MKNTRL = ABS(LKNTRL) +C +C SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS +C ZERO AND THE ERROR IS NOT FATAL. +C + IF (LEVEL.LT.2 .AND. LKNTRL.EQ.0) GO TO 30 + IF (LEVEL.EQ.0 .AND. KOUNT.GT.MAXMES) GO TO 30 + IF (LEVEL.EQ.1 .AND. KOUNT.GT.MAXMES .AND. MKNTRL.EQ.1) GO TO 30 + IF (LEVEL.EQ.2 .AND. KOUNT.GT.MAX(1,MAXMES)) GO TO 30 +C +C ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A +C MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS) +C AND SENDING IT OUT VIA XERPRN. PRINT ONLY IF CONTROL FLAG +C IS NOT ZERO. +C + IF (LKNTRL .NE. 0) THEN + TEMP(1:21) = 'MESSAGE FROM ROUTINE ' + I = MIN(LEN(SUBROU), 16) + TEMP(22:21+I) = SUBROU(1:I) + TEMP(22+I:33+I) = ' IN LIBRARY ' + LTEMP = 33 + I + I = MIN(LEN(LIBRAR), 16) + TEMP(LTEMP+1:LTEMP+I) = LIBRAR (1:I) + TEMP(LTEMP+I+1:LTEMP+I+1) = '.' + LTEMP = LTEMP + I + 1 + CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72) + ENDIF +C +C IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE +C PRINTING THE MESSAGE. THE INTRODUCTORY LINE TELLS THE CHOICE +C FROM EACH OF THE FOLLOWING THREE OPTIONS. +C 1. LEVEL OF THE MESSAGE +C 'INFORMATIVE MESSAGE' +C 'POTENTIALLY RECOVERABLE ERROR' +C 'FATAL ERROR' +C 2. WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE +C 'PROG CONTINUES' +C 'PROG ABORTED' +C 3. WHETHER OR NOT A TRACEBACK WAS REQUESTED. (THE TRACEBACK +C MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS +C WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.) +C 'TRACEBACK REQUESTED' +C 'TRACEBACK NOT REQUESTED' +C NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT +C EXCEED 74 CHARACTERS. +C WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED. +C + IF (LKNTRL .GT. 0) THEN +C +C THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL. +C + IF (LEVEL .LE. 0) THEN + TEMP(1:20) = 'INFORMATIVE MESSAGE,' + LTEMP = 20 + ELSEIF (LEVEL .EQ. 1) THEN + TEMP(1:30) = 'POTENTIALLY RECOVERABLE ERROR,' + LTEMP = 30 + ELSE + TEMP(1:12) = 'FATAL ERROR,' + LTEMP = 12 + ENDIF +C +C THEN WHETHER THE PROGRAM WILL CONTINUE. +C + IF ((MKNTRL.EQ.2 .AND. LEVEL.GE.1) .OR. + * (MKNTRL.EQ.1 .AND. LEVEL.EQ.2)) THEN + TEMP(LTEMP+1:LTEMP+14) = ' PROG ABORTED,' + LTEMP = LTEMP + 14 + ELSE + TEMP(LTEMP+1:LTEMP+16) = ' PROG CONTINUES,' + LTEMP = LTEMP + 16 + ENDIF +C +C FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK. +C + IF (LKNTRL .GT. 0) THEN + TEMP(LTEMP+1:LTEMP+20) = ' TRACEBACK REQUESTED' + LTEMP = LTEMP + 20 + ELSE + TEMP(LTEMP+1:LTEMP+24) = ' TRACEBACK NOT REQUESTED' + LTEMP = LTEMP + 24 + ENDIF + CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72) + ENDIF +C +C NOW SEND OUT THE MESSAGE. +C + CALL XERPRN (' * ', -1, MESSG, 72) +C +C IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A +C TRACEBACK. +C + IF (LKNTRL .GT. 0) THEN + WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR + DO 10 I=16,22 + IF (TEMP(I:I) .NE. ' ') GO TO 20 + 10 CONTINUE +C + 20 CALL XERPRN (' * ', -1, TEMP(1:15) // TEMP(I:23), 72) + CALL FDUMP + ENDIF +C +C IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE. +C + IF (LKNTRL .NE. 0) THEN + CALL XERPRN (' * ', -1, ' ', 72) + CALL XERPRN (' ***', -1, 'END OF MESSAGE', 72) + CALL XERPRN (' ', 0, ' ', 72) + ENDIF +C +C IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE +C CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN. +C + 30 IF (LEVEL.LE.0 .OR. (LEVEL.EQ.1 .AND. MKNTRL.LE.1)) RETURN +C +C THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A +C FATAL ERROR. PRINT THE REASON FOR THE ABORT AND THE ERROR +C SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT. +C + IF (LKNTRL.GT.0 .AND. KOUNT.LT.MAX(1,MAXMES)) THEN + IF (LEVEL .EQ. 1) THEN + CALL XERPRN + * (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72) + ELSE + CALL XERPRN(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72) + ENDIF + CALL XERSVE (' ', ' ', ' ', -1, 0, 0, KDUMMY) + CALL XERHLT (' ') + ELSE + CALL XERHLT (MESSG) + ENDIF + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/xerprn.f b/modules/nwtc-library/src/NetLib/slatec/xerprn.f new file mode 100644 index 0000000000..97eedf480f --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/xerprn.f @@ -0,0 +1,228 @@ +*DECK XERPRN + SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP) +C***BEGIN PROLOGUE XERPRN +C***SUBSIDIARY +C***PURPOSE Print error messages processed by XERMSG. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XERPRN-A) +C***KEYWORDS ERROR MESSAGES, PRINTING, XERROR +C***AUTHOR Fong, Kirby, (NMFECC at LLNL) +C***DESCRIPTION +C +C This routine sends one or more lines to each of the (up to five) +C logical units to which error messages are to be sent. This routine +C is called several times by XERMSG, sometimes with a single line to +C print and sometimes with a (potentially very long) message that may +C wrap around into multiple lines. +C +C PREFIX Input argument of type CHARACTER. This argument contains +C characters to be put at the beginning of each line before +C the body of the message. No more than 16 characters of +C PREFIX will be used. +C +C NPREF Input argument of type INTEGER. This argument is the number +C of characters to use from PREFIX. If it is negative, the +C intrinsic function LEN is used to determine its length. If +C it is zero, PREFIX is not used. If it exceeds 16 or if +C LEN(PREFIX) exceeds 16, only the first 16 characters will be +C used. If NPREF is positive and the length of PREFIX is less +C than NPREF, a copy of PREFIX extended with blanks to length +C NPREF will be used. +C +C MESSG Input argument of type CHARACTER. This is the text of a +C message to be printed. If it is a long message, it will be +C broken into pieces for printing on multiple lines. Each line +C will start with the appropriate prefix and be followed by a +C piece of the message. NWRAP is the number of characters per +C piece; that is, after each NWRAP characters, we break and +C start a new line. In addition the characters '$$' embedded +C in MESSG are a sentinel for a new line. The counting of +C characters up to NWRAP starts over for each new line. The +C value of NWRAP typically used by XERMSG is 72 since many +C older error messages in the SLATEC Library are laid out to +C rely on wrap-around every 72 characters. +C +C NWRAP Input argument of type INTEGER. This gives the maximum size +C piece into which to break MESSG for printing on multiple +C lines. An embedded '$$' ends a line, and the count restarts +C at the following character. If a line break does not occur +C on a blank (it would split a word) that word is moved to the +C next line. Values of NWRAP less than 16 will be treated as +C 16. Values of NWRAP greater than 132 will be treated as 132. +C The actual line length will be NPREF + NWRAP after NPREF has +C been adjusted to fall between 0 and 16 and NWRAP has been +C adjusted to fall between 16 and 132. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED I1MACH, XGETUA +C***REVISION HISTORY (YYMMDD) +C 880621 DATE WRITTEN +C 880708 REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF +C JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK +C THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE +C SLASH CHARACTER IN FORMAT STATEMENTS. +C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO +C STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK +C LINES TO BE PRINTED. +C 890721 REVISED TO ADD A NEW FEATURE. A NEGATIVE VALUE OF NPREF +C CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH. +C 891013 REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH. +C 891214 Prologue converted to Version 4.0 format. (WRB) +C 900510 Added code to break messages between words. (RWC) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERPRN + CHARACTER*(*) PREFIX, MESSG + INTEGER NPREF, NWRAP + CHARACTER*148 CBUFF + INTEGER IU(5), NUNIT + CHARACTER*2 NEWLIN + PARAMETER (NEWLIN = '$$') +C***FIRST EXECUTABLE STATEMENT XERPRN + CALL XGETUA(IU,NUNIT) +C +C A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD +C ERROR MESSAGE UNIT INSTEAD. I1MACH(4) RETRIEVES THE STANDARD +C ERROR MESSAGE UNIT. +C + N = I1MACH(4) + DO 10 I=1,NUNIT + IF (IU(I) .EQ. 0) IU(I) = N + 10 CONTINUE +C +C LPREF IS THE LENGTH OF THE PREFIX. THE PREFIX IS PLACED AT THE +C BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING +C THE REST OF THIS ROUTINE. +C + IF ( NPREF .LT. 0 ) THEN + LPREF = LEN(PREFIX) + ELSE + LPREF = NPREF + ENDIF + LPREF = MIN(16, LPREF) + IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX +C +C LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE +C TIME FROM MESSG TO PRINT ON ONE LINE. +C + LWRAP = MAX(16, MIN(132, NWRAP)) +C +C SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS. +C + LENMSG = LEN(MESSG) + N = LENMSG + DO 20 I=1,N + IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30 + LENMSG = LENMSG - 1 + 20 CONTINUE + 30 CONTINUE +C +C IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE. +C + IF (LENMSG .EQ. 0) THEN + CBUFF(LPREF+1:LPREF+1) = ' ' + DO 40 I=1,NUNIT + WRITE(IU(I), '(A)') CBUFF(1:LPREF+1) + 40 CONTINUE + RETURN + ENDIF +C +C SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING +C STARTS. FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL. +C WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT. +C WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED. +C +C WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL. THE +C INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE +C OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH +C OF THE SECOND ARGUMENT. +C +C THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE +C FOLLOWING ORDER. WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER +C OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT +C POSITION NEXTC. +C +C LPIECE .EQ. 0 THE NEW LINE SENTINEL DOES NOT OCCUR IN THE +C REMAINDER OF THE CHARACTER STRING. LPIECE +C SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC, +C WHICHEVER IS LESS. +C +C LPIECE .EQ. 1 THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC: +C NEXTC). LPIECE IS EFFECTIVELY ZERO, AND WE +C PRINT NOTHING TO AVOID PRODUCING UNNECESSARY +C BLANK LINES. THIS TAKES CARE OF THE SITUATION +C WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF +C EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE +C SENTINEL FOLLOWED BY MORE CHARACTERS. NEXTC +C SHOULD BE INCREMENTED BY 2. +C +C LPIECE .GT. LWRAP+1 REDUCE LPIECE TO LWRAP. +C +C ELSE THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1 +C RESET LPIECE = LPIECE-1. NOTE THAT THIS +C PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ. +C LWRAP+1. THAT IS, THE SENTINEL FALLS EXACTLY +C AT THE END OF A LINE. +C + NEXTC = 1 + 50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN) + IF (LPIECE .EQ. 0) THEN +C +C THERE WAS NO NEW LINE SENTINEL FOUND. +C + IDELTA = 0 + LPIECE = MIN(LWRAP, LENMSG+1-NEXTC) + IF (LPIECE .LT. LENMSG+1-NEXTC) THEN + DO 52 I=LPIECE+1,2,-1 + IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN + LPIECE = I-1 + IDELTA = 1 + GOTO 54 + ENDIF + 52 CONTINUE + ENDIF + 54 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) + NEXTC = NEXTC + LPIECE + IDELTA + ELSEIF (LPIECE .EQ. 1) THEN +C +C WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1). +C DON'T PRINT A BLANK LINE. +C + NEXTC = NEXTC + 2 + GO TO 50 + ELSEIF (LPIECE .GT. LWRAP+1) THEN +C +C LPIECE SHOULD BE SET DOWN TO LWRAP. +C + IDELTA = 0 + LPIECE = LWRAP + DO 56 I=LPIECE+1,2,-1 + IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN + LPIECE = I-1 + IDELTA = 1 + GOTO 58 + ENDIF + 56 CONTINUE + 58 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) + NEXTC = NEXTC + LPIECE + IDELTA + ELSE +C +C IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1. +C WE SHOULD DECREMENT LPIECE BY ONE. +C + LPIECE = LPIECE - 1 + CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) + NEXTC = NEXTC + LPIECE + 2 + ENDIF +C +C PRINT +C + DO 60 I=1,NUNIT + WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE) + 60 CONTINUE +C + IF (NEXTC .LE. LENMSG) GO TO 50 + RETURN + END diff --git a/modules/nwtc-library/src/NetLib/slatec/xersve.f b/modules/nwtc-library/src/NetLib/slatec/xersve.f new file mode 100644 index 0000000000..6bd2a4f7ad --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/xersve.f @@ -0,0 +1,155 @@ +*DECK XERSVE + SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, + + ICOUNT) +C***BEGIN PROLOGUE XERSVE +C***SUBSIDIARY +C***PURPOSE Record that an error has occurred. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3 +C***TYPE ALL (XERSVE-A) +C***KEYWORDS ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C *Usage: +C +C INTEGER KFLAG, NERR, LEVEL, ICOUNT +C CHARACTER * (len) LIBRAR, SUBROU, MESSG +C +C CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT) +C +C *Arguments: +C +C LIBRAR :IN is the library that the message is from. +C SUBROU :IN is the subroutine that the message is from. +C MESSG :IN is the message to be saved. +C KFLAG :IN indicates the action to be performed. +C when KFLAG > 0, the message in MESSG is saved. +C when KFLAG=0 the tables will be dumped and +C cleared. +C when KFLAG < 0, the tables will be dumped and +C not cleared. +C NERR :IN is the error number. +C LEVEL :IN is the error severity. +C ICOUNT :OUT the number of times this message has been seen, +C or zero if the table has overflowed and does not +C contain this message specifically. When KFLAG=0, +C ICOUNT will not be altered. +C +C *Description: +C +C Record that this error occurred and possibly dump and clear the +C tables. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED I1MACH, XGETUA +C***REVISION HISTORY (YYMMDD) +C 800319 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900413 Routine modified to remove reference to KFLAG. (WRB) +C 900510 Changed to add LIBRARY NAME and SUBROUTINE to calling +C sequence, use IF-THEN-ELSE, make number of saved entries +C easily changeable, changed routine name from XERSAV to +C XERSVE. (RWC) +C 910626 Added LIBTAB and SUBTAB to SAVE statement. (BKS) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XERSVE + PARAMETER (LENTAB=10) + INTEGER LUN(5) + CHARACTER*(*) LIBRAR, SUBROU, MESSG + CHARACTER*8 LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB + CHARACTER*20 MESTAB(LENTAB), MES + DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB) + SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG + DATA KOUNTX/0/, NMSG/0/ +C***FIRST EXECUTABLE STATEMENT XERSVE +C + IF (KFLAG.LE.0) THEN +C +C Dump the table. +C + IF (NMSG.EQ.0) RETURN +C +C Print to each unit. +C + CALL XGETUA (LUN, NUNIT) + DO 20 KUNIT = 1,NUNIT + IUNIT = LUN(KUNIT) + IF (IUNIT.EQ.0) IUNIT = I1MACH(4) +C +C Print the table header. +C + WRITE (IUNIT,9000) +C +C Print body of table. +C + DO 10 I = 1,NMSG + WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I), + * NERTAB(I),LEVTAB(I),KOUNT(I) + 10 CONTINUE +C +C Print number of other errors. +C + IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX + WRITE (IUNIT,9030) + 20 CONTINUE +C +C Clear the error tables. +C + IF (KFLAG.EQ.0) THEN + NMSG = 0 + KOUNTX = 0 + ENDIF + ELSE +C +C PROCESS A MESSAGE... +C SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG, +C OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL. +C + LIB = LIBRAR + SUB = SUBROU + MES = MESSG + DO 30 I = 1,NMSG + IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND. + * MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND. + * LEVEL.EQ.LEVTAB(I)) THEN + KOUNT(I) = KOUNT(I) + 1 + ICOUNT = KOUNT(I) + RETURN + ENDIF + 30 CONTINUE +C + IF (NMSG.LT.LENTAB) THEN +C +C Empty slot found for new message. +C + NMSG = NMSG + 1 + LIBTAB(I) = LIB + SUBTAB(I) = SUB + MESTAB(I) = MES + NERTAB(I) = NERR + LEVTAB(I) = LEVEL + KOUNT (I) = 1 + ICOUNT = 1 + ELSE +C +C Table is full. +C + KOUNTX = KOUNTX+1 + ICOUNT = 0 + ENDIF + ENDIF + RETURN +C +C Formats. +C + 9000 FORMAT ('0 ERROR MESSAGE SUMMARY' / + + ' LIBRARY SUBROUTINE MESSAGE START NERR', + + ' LEVEL COUNT') + 9010 FORMAT (1X,A,3X,A,3X,A,3I10) + 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10) + 9030 FORMAT (1X) + END diff --git a/modules/nwtc-library/src/NetLib/slatec/xgetua.f b/modules/nwtc-library/src/NetLib/slatec/xgetua.f new file mode 100644 index 0000000000..2e7db02123 --- /dev/null +++ b/modules/nwtc-library/src/NetLib/slatec/xgetua.f @@ -0,0 +1,51 @@ +*DECK XGETUA + SUBROUTINE XGETUA (IUNITA, N) +C***BEGIN PROLOGUE XGETUA +C***PURPOSE Return unit number(s) to which error messages are being +C sent. +C***LIBRARY SLATEC (XERROR) +C***CATEGORY R3C +C***TYPE ALL (XGETUA-A) +C***KEYWORDS ERROR, XERROR +C***AUTHOR Jones, R. E., (SNLA) +C***DESCRIPTION +C +C Abstract +C XGETUA may be called to determine the unit number or numbers +C to which error messages are being sent. +C These unit numbers may have been set by a call to XSETUN, +C or a call to XSETUA, or may be a default value. +C +C Description of Parameters +C --Output-- +C IUNIT - an array of one to five unit numbers, depending +C on the value of N. A value of zero refers to the +C default unit, as defined by the I1MACH machine +C constant routine. Only IUNIT(1),...,IUNIT(N) are +C defined by XGETUA. The values of IUNIT(N+1),..., +C IUNIT(5) are not defined (for N .LT. 5) or altered +C in any way by XGETUA. +C N - the number of units to which copies of the +C error messages are being sent. N will be in the +C range from 1 to 5. +C +C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC +C Error-handling Package, SAND82-0800, Sandia +C Laboratories, 1982. +C***ROUTINES CALLED J4SAVE +C***REVISION HISTORY (YYMMDD) +C 790801 DATE WRITTEN +C 861211 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 920501 Reformatted the REFERENCES section. (WRB) +C***END PROLOGUE XGETUA + DIMENSION IUNITA(5) +C***FIRST EXECUTABLE STATEMENT XGETUA + N = J4SAVE(5,0,.FALSE.) + DO 30 I=1,N + INDEX = I+4 + IF (I.EQ.1) INDEX = 3 + IUNITA(I) = J4SAVE(INDEX,0,.FALSE.) + 30 CONTINUE + RETURN + END diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index b9eda5344b..d8eb0b0c72 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -24,11 +24,6 @@ usefrom ^ ^ CHARACTER(ChanLen) Name usefrom ^ ^ CHARACTER(ChanLen) Units usefrom ^ ^ IntKi SignM -usefrom NWTC_Library OutParmFFType IntKi Indx -usefrom ^ ^ CHARACTER(ChanLenFF) Name -usefrom ^ ^ CHARACTER(ChanLenFF) Units -usefrom ^ ^ IntKi SignM - usefrom NWTC_Library FileInfoType IntKi NumLines usefrom ^ ^ IntKi NumFiles usefrom ^ ^ IntKi FileLine {:} @@ -64,17 +59,13 @@ usefrom ^ ^ MeshType Augmented_L usefrom ^ ^ MeshType Lumped_Points_Src - usefrom ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} usefrom ^ ^ R8Ki DisplacedPosition {:}{:}{:} -usefrom ^ ^ R8Ki LoadLn2_F {:}{:} usefrom ^ ^ R8Ki LoadLn2_A_Mat {:}{:} +usefrom ^ ^ R8Ki LoadLn2_F {:}{:} usefrom ^ ^ R8Ki LoadLn2_M {:}{:} usefrom ^ ^ MeshMapLinearizationType dM - -#bjj ???: add Marshall's FNlist_Type, InpErrsType, too???? - - -# ----------- NWTC_Num.f90 --------------------------------- -#bjj ???: use Marshall's CubSplineType, RegCubSplineType, RegGridType - - +usefrom NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +usefrom ^ ^ IntKi RandSeed {3} +usefrom ^ ^ IntKi RandSeedAry {:} +usefrom ^ ^ CHARACTER(6) RNG_type diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt index 8dd68da34d..bb2096f1fd 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt @@ -27,13 +27,13 @@ typedef ^ ^ R8Ki M_f { typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for loads on the mesh" typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motions and/or scalars on the mesh" -typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then betwee augmented source and destination" +typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination" typedef ^ ^ MeshType Augmented_Ln2_Src - - - "temporary mesh for storing augmented line2 source values" typedef ^ ^ MeshType Lumped_Points_Src - - - "temporary mesh for lumping lines to points, stored here for efficiency" -typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorizatioin of LoadLn2_A_Mat" +typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorization of LoadLn2_A_Mat" typedef ^ ^ R8Ki DisplacedPosition {:}{:}{:} - - "couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency)" -typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ MeshMapLinearizationType dM #typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt index d0c0abe726..b69bd3831b 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt @@ -24,10 +24,6 @@ typedef ^ ^ CHARACTER(ChanLen) Name - - typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" -typedef NWTC_Library OutParmFFType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLenFF) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLenFF) Units - - - "Units this channel is specified in" -typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" typedef NWTC_Library FileInfoType IntKi NumLines typedef ^ ^ IntKi NumFiles diff --git a/modules/nwtc-library/src/SingPrec.f90 b/modules/nwtc-library/src/SingPrec.f90 index c8b4bca350..3f98240cda 100644 --- a/modules/nwtc-library/src/SingPrec.f90 +++ b/modules/nwtc-library/src/SingPrec.f90 @@ -28,6 +28,10 @@ MODULE Precision !.................................................................................................................................. +#ifdef HAS_FORTRAN2008_FEATURES +USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128 +#endif + IMPLICIT NONE INTEGER, PARAMETER :: B1Ki = SELECTED_INT_KIND( 2 ) !< Kind for one-byte whole numbers @@ -35,9 +39,15 @@ MODULE Precision INTEGER, PARAMETER :: B4Ki = SELECTED_INT_KIND( 9 ) !< Kind for four-byte whole numbers INTEGER, PARAMETER :: B8Ki = SELECTED_INT_KIND( 18 ) !< Kind for eight-byte whole numbers +#ifdef HAS_FORTRAN2008_FEATURES +INTEGER, PARAMETER :: QuKi = real128 !< Kind for 16-byte, floating-point numbers +INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers +INTEGER, PARAMETER :: SiKi = real32 !< Kind for four-byte, floating-point numbers +#else INTEGER, PARAMETER :: QuKi = SELECTED_REAL_KIND( 20, 500 ) !< Kind for 16-byte, floating-point numbers INTEGER, PARAMETER :: R8Ki = SELECTED_REAL_KIND( 14, 300 ) !< Kind for eight-byte floating-point numbers INTEGER, PARAMETER :: SiKi = SELECTED_REAL_KIND( 6, 30 ) !< Kind for four-byte, floating-point numbers +#endif INTEGER, PARAMETER :: BYTES_IN_SiKi = 4 !< Number of bytes per SiKi number INTEGER, PARAMETER :: BYTES_IN_R8Ki = 8 !< Number of bytes per R8Ki number @@ -50,7 +60,7 @@ MODULE Precision INTEGER, PARAMETER :: IntKi = B4Ki !< Default kind for integers INTEGER, PARAMETER :: BYTES_IN_INT = 4 !< Number of bytes per IntKi number - use SIZEOF() -#ifndef DOUBLE_PRECISION +#if !defined (DOUBLE_PRECISION) && !defined (OPENFAST_DOUBLE_PRECISION) INTEGER, PARAMETER :: ReKi = SiKi !< Default kind for floating-point numbers INTEGER, PARAMETER :: DbKi = R8Ki !< Default kind for double floating-point numbers diff --git a/modules/nwtc-library/tests/test_NWTC_IO_CheckArgs.F90 b/modules/nwtc-library/tests/test_NWTC_IO_CheckArgs.F90 index 0ab007824b..1249751ea3 100644 --- a/modules/nwtc-library/tests/test_NWTC_IO_CheckArgs.F90 +++ b/modules/nwtc-library/tests/test_NWTC_IO_CheckArgs.F90 @@ -5,6 +5,10 @@ module test_NWTC_IO_CheckArgs implicit none + integer, parameter :: stdout=6 + character(9), parameter :: nullfile="/dev/null" + character(11), parameter :: terminal="/dev/stdout" + contains ! PASSING CASES @@ -27,7 +31,9 @@ subroutine test_input_file_user_specified() argument_array = (/ & "first_arg.txt " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "", second_argument ) @@ -46,7 +52,9 @@ subroutine test_input_file_default() filename = "default.txt" allocate(argument_array(0)) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "default.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "", second_argument ) @@ -66,7 +74,9 @@ subroutine test_input_file_default_user_specified() argument_array = (/ & "first_arg.txt " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "", second_argument ) @@ -95,7 +105,9 @@ subroutine test_restart_flag1() "first_arg.txt ", & "second_arg " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "second_arg", second_argument ) @@ -119,7 +131,9 @@ subroutine test_restart_flag2() "-restart ", & "second_arg " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "second_arg", second_argument ) @@ -142,7 +156,9 @@ subroutine test_restart_flag3() "-restart ", & "first_arg.txt " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "", filename ) @assertEqual( 0, error_status ) @assertEqual( "first_arg.txt", second_argument ) @@ -169,7 +185,9 @@ subroutine test_second_argument() "first_arg.txt ", & "second_arg " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "second_arg", second_argument ) @@ -196,7 +214,9 @@ subroutine test_help1() "-h ", & "first_arg.txt " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "", second_argument ) @@ -219,7 +239,9 @@ subroutine test_help2() "first_arg.txt ", & "-h " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 0, error_status ) @assertEqual( "", second_argument ) @@ -227,6 +249,60 @@ subroutine test_help2() deallocate(argument_array) end subroutine + ! ************************************************************************ + ! The version flag in any position should show the version info and exit + ! normally. + + @test + subroutine test_version1() + + ! executable.exe -v FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate(argument_array(2)) + argument_array = (/ & + "-v ", & + "first_arg.txt " & + /) + open(unit=stdout, file=nullfile, status="old") + call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") + @assertEqual( "first_arg.txt", filename ) + @assertEqual( 0, error_status ) + @assertEqual( "", second_argument ) + @assertEqual( "V", flag ) + deallocate(argument_array) + end subroutine + + @test + subroutine test_version2() + + ! executable.exe FileName -VERSION + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate(argument_array(2)) + argument_array = (/ & + "first_arg.txt ", & + "-VERSION " & + /) + open(unit=stdout, file=nullfile, status="old") + call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") + @assertEqual( "first_arg.txt", filename ) + @assertEqual( 0, error_status ) + @assertEqual( "", second_argument ) + @assertEqual( "VERSION", flag ) + deallocate(argument_array) + end subroutine + ! FAILING CASES ! ************************************************************************ @@ -241,7 +317,9 @@ subroutine test_no_args_no_default() filename = "" allocate(argument_array(0)) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "", filename ) @assertEqual( 4, error_status ) @assertEqual( "", second_argument ) @@ -265,7 +343,9 @@ subroutine test_unsupported_flag() "first_arg.txt ", & "-flag " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "first_arg.txt", filename ) @assertEqual( 4, error_status ) @assertEqual( "", second_argument ) @@ -288,7 +368,9 @@ subroutine test_restart_bad_syntax() argument_array = (/ & "-restart " & /) + open(unit=stdout, file=nullfile, status="old") call CheckArgs( filename, error_status, second_argument, flag, argument_array ) + open(unit=stdout, file=terminal, status="old") @assertEqual( "", filename ) @assertEqual( 4, error_status ) @assertEqual( "", second_argument ) diff --git a/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 b/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 new file mode 100644 index 0000000000..4e3d472f08 --- /dev/null +++ b/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 @@ -0,0 +1,58 @@ +module test_NWTC_RandomNumber + + use pFUnit_mod + use NWTC_RandomNumber + + implicit none + + integer, parameter :: stdout=6 + character(9), parameter :: nullfile="/dev/null" + character(11), parameter :: terminal="/dev/stdout" + +contains + +@test +subroutine test_RANLUX() + + type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + + real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers + + p%pRNG = pRNG_RANLUX + p%RandSeed(1) = 1 + + call RandNum_Init(p, error_status, error_message) + @assertEqual( 0, error_status ) + + call UniformRandomNumbers(p%pRNG, random_numbers) + @assertEqual( (/ 0.94589489698410034, 0.47347849607467651 /), random_numbers ) + +end subroutine + +@test +subroutine test_INTRINSIC() + + type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + + integer :: expected_seed_count + real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers + + p%pRNG = pRNG_INTRINSIC + p%RandSeed(1) = 1 + p%RandSeed(2) = 2 + + open(unit=stdout, file=nullfile, status="old") + call RandNum_Init(p, error_status, error_message) + open(unit=stdout, file=terminal, status="old") + @assertEqual( 0, error_status ) + + ! We cant use this test since it will fail for various machine/compiler combinations + ! call UniformRandomNumbers(p%pRNG, random_numbers) + ! @assertEqual( (/ 0.80377975339288821, 0.47469797199574959 /), random_numbers ) +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index c1d1aa099c..b02b577e0d 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -21,7 +21,7 @@ MODULE FAST_Data REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time INTEGER(IntKi) :: NumTurbines INTEGER, PARAMETER :: IntfStrLen = 1025 ! length of strings through the C interface - INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 1000 ! Maximum number of outputs + INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 10 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 8 @@ -497,13 +497,19 @@ subroutine FAST_OpFM_Init(iTurb, TMax, InputFileName_c, TurbID, NumSC2Ctrl, NumC ExternInitData%NumActForcePtsTower = NumActForcePtsTower CALL FAST_InitializeAll_T( t_initial, 1_IntKi, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) - + ! set values for return to OpenFOAM AbortErrLev_c = AbortErrLev dt_c = Turbine(iTurb)%p_FAST%dt ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + + IF ( ErrStat >= AbortErrLev ) THEN + CALL WrScr( "Error in FAST_OpFM_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) + IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) + RETURN + END IF call SetOpenFOAM_pointers(iTurb, OpFM_Input_from_FAST, OpFM_Output_to_FAST, SC_Input_from_FAST, SC_Output_to_FAST) diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 8ccb055912..2d1e7833ce 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -43,7 +43,7 @@ EXTERNAL_ROUTINE void FAST_CreateCheckpoint(int * iTurb, const char *CheckpointR // make sure these parameters match with FAST_Library.f90 #define MAXIMUM_BLADES 3 -#define MAXIMUM_OUTPUTS 1000 +#define MAXIMUM_OUTPUTS 4000 #define CHANNEL_LENGTH 10 #define MAXInitINPUTS 10 diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 9cae3b1305..d31d3c4070 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -30,13 +30,14 @@ MODULE FAST_Linear !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes some variables for linearization. -SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) +SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - INTEGER(IntKi), INTENT(IN) :: NumBl !< Number of blades (for index into ED input array) + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + INTEGER(IntKi), INTENT(IN ) :: NumBl !< Number of blades (for index into ED input array) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -44,13 +45,14 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) INTEGER(IntKi) :: i, j, k ! loop/temp variables INTEGER(IntKi) :: ThisModule ! Module ID # INTEGER(IntKi) :: NumInstances ! Number of instances of each module + INTEGER(IntKi) :: NumStates ! Number of states required for the x_eig arrays INTEGER(IntKi) :: i_u ! loop/temp variables INTEGER(IntKi) :: i_y, i_x ! loop/temp variables INTEGER(IntKi) :: NextStart(3) ! allocated to be size(LinStartIndx)=size(SizeLin); helps compute the next starting index for the module components INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'Init_Lin' CHARACTER(200) :: ModAbrev @@ -94,12 +96,30 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_AD end if - - + + ! HydroDyn is next, if activated: + if ( p_FAST%CompHydro == Module_HD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_HD + end if + + ! MAP is next, if activated: + 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 + end if + + ! ExtPtfm is next, if activated: + if ( p_FAST%CompSub == Module_ExtPtfm ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_ExtPtfm + end if + !..................... ! determine total number of inputs/outputs/contStates: !..................... y_FAST%Lin%Glue%SizeLin = 0 + y_FAST%Lin%Glue%NumOutputs = 0 do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) @@ -111,6 +131,8 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x)) y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x) y_FAST%Lin%Glue%SizeLin = y_FAST%Lin%Glue%SizeLin + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin ! total number of inputs, outputs, and continuous states + + y_FAST%Lin%Glue%NumOutputs = y_FAST%Lin%Glue%NumOutputs + y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs ! total number of WriteOutputs end do end do @@ -131,7 +153,6 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) ! ................................... ! determine which of the module inputs/outputs are written to file ! ................................... - !NumBl = size(u_ED%BlPitchCom) call Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -153,6 +174,8 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) call AllocAry( y_FAST%Lin%Glue%RotFrame_y, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'RotFrame_y', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%RotFrame_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'RotFrame_x', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%DerivOrder_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'DerivOrder_x', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%IsLoad_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'IsLoad_u', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -190,7 +213,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! outputs - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + do k=1,NumInstances if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) end if @@ -208,11 +231,33 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! continuous states - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + do k=1,NumInstances if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) end if + if (y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) > 0) then + if (p_FAST%WrVTK == VTK_ModeShapes) then ! allocate these for restart later + if (ThisModule == Module_ED) then + ! ED states are only the active DOFs, but when we perturb the OP [in PerturbOP()], we need the index + NumStates = ED%p%NDOF*2 + else + NumStates = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + end if + + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag, NumStates, 'op_x_eig_mag', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase, NumStates, 'op_x_eig_phase', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) return + + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag = 0.0_R8Ki + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase = 0.0_R8Ki + end if + end if + + do j=1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) y_FAST%Lin%Glue%names_x( i_x) = TRIM(ModAbrev)//' '//y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x( j) if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_x)) then @@ -220,12 +265,74 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) else y_FAST%Lin%Glue%RotFrame_x(i_x) = .false. end if + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%DerivOrder_x)) then + y_FAST%Lin%Glue%DerivOrder_x(i_x) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%DerivOrder_x(j) + else + y_FAST%Lin%Glue%DerivOrder_x(i_x) = 0 + end if i_x = i_x + 1; end do end do end do ! each module + + !..................... + ! initialize variables for periodic steady state solution + !..................... + + m_FAST%Lin%NextLinTimeIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_NEWCOPY + m_FAST%Lin%n_rot = 0 + m_FAST%Lin%IsConverged = .false. + m_FAST%Lin%FoundSteady = .false. + m_FAST%Lin%AzimIndx = 1 + + p_FAST%AzimDelta = TwoPi / p_FAST%NLinTimes + + ! allocate space to save operating points + if (p_FAST%CalcSteady .or. p_FAST%WrVTK==VTK_ModeShapes) then + + call AllocateOP(p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! allocate spaces for variables needed to determine + if (p_FAST%CalcSteady) then + + !call AllocAry(m_FAST%Lin%AzimTarget, p_FAST%NLinTimes,'AzimTarget', ErrStat2, ErrMsg2) + allocate( m_FAST%Lin%AzimTarget(0 : p_FAST%NLinTimes+1), stat=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal,"Unable to allocate space for AzimTarget.",ErrStat,ErrMsg,RoutineName) + end if + + call AllocAry( m_FAST%Lin%LinTimes, p_FAST%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Psi, p_FAST%LinInterpOrder+1, 'Psi', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! these flattened output arrays will contain spaces for %WriteOutputs, which are being ignored for purposes of CalcSteady computations + call AllocAry( m_FAST%Lin%y_interp, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_interp', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Y_prevRot, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), p_FAST%NLinTimes, 'Y_prevRot', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%y_ref, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_ref', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat < AbortErrLev) then + m_FAST%Lin%y_interp = 0.0_R8Ki + m_FAST%Lin%Y_prevRot = 0.0_R8Ki + m_FAST%Lin%y_ref = 1.0_R8Ki + end if + + end if + + end if + + END SUBROUTINE Init_Lin !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes the names and rotating frame portion of IfW. @@ -326,7 +433,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) INTEGER(IntKi) :: ThisModule ! Module ID # INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'Init_Lin_InputOutput' @@ -380,7 +487,20 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do end if - + + ! HD standard inputs: WaveElev0 + if (p_FAST%CompHydro == MODULE_HD) then + y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)) = .true. + end if + + !bjj: removed because I'm not sure these should be included in the "standard" inputs + !!!! ExtPtfm standard inputs: x1, x1dot x1ddot ! TODO TODO TODO CHECK + !!!if (p_FAST%CompSub == MODULE_ExtPtfm) then + !!! do j = 1,18 + !!! y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + !!! end do + !!!end if + elseif(p_FAST%LinInputs == LIN_ALL) then do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) @@ -409,7 +529,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) ThisModule = p_FAST%Lin_ModOrder( i ) do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) - col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !first column where WriteOutput occurs + col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !last column before WriteOutput occurs do j=1,col y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y(j) = .false. end do @@ -432,7 +552,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) END SUBROUTINE Init_Lin_InputOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that performs lineaization at current operating point for a turbine. -SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time @@ -444,12 +564,12 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module @@ -465,45 +585,65 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! local variables INTEGER(IntKi) :: Un ! unit number for linearization output file (written in two parts) INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' - REAL(R8Ki), ALLOCATABLE :: dYdz(:,:), dZdz(:,:), dZdu(:,:) REAL(R8Ki), ALLOCATABLE :: dUdu(:,:), dUdy(:,:) ! variables for glue-code linearization +#ifdef OLD_AD_LINEAR + REAL(R8Ki), ALLOCATABLE :: dYdz(:,:), dZdz(:,:), dZdu(:,:) INTEGER(IntKi), ALLOCATABLE :: ipiv(:) +#endif integer(intki) :: NumBl integer(intki) :: k CHARACTER(1024) :: LinRootName CHARACTER(1024) :: OutFileName + CHARACTER(200) :: SimStr + CHARACTER(MaxWrScrLen) :: BlankLine ErrStat = ErrID_None ErrMsg = "" Un = -1 + + !..................... + SimStr = '(RotSpeed='//trim(num2lstr(ED%y%RotSpeed*RPS2RPM))//' rpm, BldPitch1='//trim(num2lstr(ED%y%BlPitch(1)*R2D))//' deg)' + BlankLine = "" + CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces + CALL WrOver ( ' Performing linearization '//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM( Num2LStr(t_global) )//' s. '//trim(SimStr) ) + CALL WrScr('') + + !..................... - LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%NextLinTimeIndx)) + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) + + if (p_FAST%WrVTK == VTK_ModeShapes .and. .not. p_FAST%CalcSteady) then ! we already saved these for the CalcSteady case + call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + !m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY ! we need a new copy for each LinTime + end if + NumBl = size(ED%Input(1)%BlPitchCom) - y_FAST%Lin%RotSpeed = ED%Output(1)%RotSpeed - y_FAST%Lin%Azimuth = ED%Output(1)%LSSTipPxa + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa !..................... ! ElastoDyn !..................... ! get the jacobians call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get the operating point call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & - x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() @@ -606,7 +746,9 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if end do - end if + end if !BeamDyn + + !..................... ! InflowWind !..................... @@ -701,13 +843,19 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 !..................... if ( p_FAST%CompAero == Module_AD ) then ! get the jacobians - call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & +#ifdef OLD_AD_LINEAR + call AD_JacobianPInput_orig( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, dZdu=dZdu ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call AD_JacobianPConstrState( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdz=dYdz, dZdz=dZdz ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +#else + call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +#endif ! get the operating point call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & @@ -732,6 +880,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 if (p_FAST%LinOutJac) then ! Jacobians +#ifdef OLD_AD_LINEAR ! dZdz: call WrPartialMatrix( dZdz, Un, p_FAST%OutFmt, 'dZdz' ) @@ -740,16 +889,16 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! dYdz: call WrPartialMatrix( dYdz, Un, p_FAST%OutFmt, 'dYdz', UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y ) - +#endif !dYdu: call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y, UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) end if +#ifdef OLD_AD_LINEAR end if - call allocAry( ipiv, size(dZdz,1), 'ipiv', ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -771,19 +920,163 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 !y_FAST%Lin%Modules(Module_AD)%D = y_FAST%Lin%Modules(Module_AD)%D - matmul(dYdz, dZdu ) call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dYdz, dZdu, 1.0_R8Ki, y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, ErrStat2, ErrMsg2 ) - if (p_FAST%LinOutMod) then +#endif ! finish writing the file call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1) ) end if +#ifdef OLD_AD_LINEAR ! AD doesn't need these any more, and we may need them for other modules if (allocated(dYdz)) deallocate(dYdz) if (allocated(dZdz)) deallocate(dZdz) if (allocated(dZdu)) deallocate(dZdu) - if (allocated(ipiv)) deallocate(ipiv) + if (allocated(ipiv)) deallocate(ipiv) +#endif + + end if + + !..................... + ! HydroDyn + !..................... + if ( p_FAST%CompHydro == Module_HD ) then + ! get the jacobians + call HD_JacobianPInput( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%B ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call HD_JacobianPContState( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_HD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dXdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) + + !dXdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_u ) + + ! dYdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_y ) + + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_u ) + + end if + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_HD)%Instance(1) ) + + end if ! LIN-TODO: Check if this is really where we want to terminate the if block end if + !..................... + ! MAP + !..................... + if ( p_FAST%CompMooring == Module_MAP ) then + ! LIN-TODO: We need this to compute the dYdu total derivative which is D for MAP, and the template uses OtherSt(STATE_CURR), but the FAST MAP DATA has OtherSt as a scalar + call MAP_JacobianPInput( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), & + MAPp%OtherSt, MAPp%y, ErrStat2, ErrMsg2, y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! et the operating point + !LIN-TODO: template uses OtherSt(STATE_CURR), but the FAST MAP DATA has OtherSt as a scalar + 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, ErrStat2, ErrMsg2, & + y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_u, y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_MAP)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_MAP)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & + UseRow=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_MAP)%Instance(1) ) + + end if ! if ( p_FAST%LinOutMod ) + end if ! if ( p_FAST%CompMooring == Module_MAP ) + !..................... + ! ExtPtfm + !..................... + if ( p_FAST%CompSub == Module_ExtPtfm ) then + ! get the jacobians + call ExtPtfm_JacobianPInput( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & + ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B ) + if(Failed()) return; + + call ExtPtfm_JacobianPContState( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & + ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2,& + dYdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A ) + if(Failed()) return; + + ! get the operating point + call ExtPtfm_GetOP(t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR),& + ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_u,& + y_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_dx) + if(Failed()) return; + + ! write the module matrices: + if (p_FAST%LinOutMod) then + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) + if(Failed()) return; + + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) + end if + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1) ) + end if + end if ! ExtPtfm + !..................... ! Linearization of glue code Input/Output solve: @@ -802,7 +1095,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if ! get the dUdu and dUdy matrices, which linearize SolveOption2 for the modules we've included in linearization - call Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & + call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then @@ -838,18 +1131,27 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! Write the results to the file: call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 + contains + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed subroutine cleanup() +#ifdef OLD_AD_LINEAR if (allocated(dYdz)) deallocate(dYdz) if (allocated(dZdz)) deallocate(dZdz) if (allocated(dZdu)) deallocate(dZdu) if (allocated(ipiv)) deallocate(ipiv) +#endif if (allocated(dUdu)) deallocate(dUdu) if (allocated(dUdy)) deallocate(dUdy) if (Un > 0) close(Un) - + end subroutine cleanup END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- @@ -869,7 +1171,7 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'WrLinFile_txt_Head' INTEGER(IntKi) :: n(5) ! sizes of arrays to print CHARACTER(*), PARAMETER :: TypeNames(5) = (/ 'continuous states', & @@ -940,6 +1242,7 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E Desc = 'Simulation time:'; WRITE (Un, fmt) Desc, t_global, 's' Desc = 'Rotor Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%RotSpeed, 'rad/s' Desc = 'Azimuth:'; WRITE (Un, fmt) Desc, y_FAST%Lin%Azimuth, 'rad' + Desc = 'Wind Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%WindSpeed, 'm/s' fmt = '(3x,A,1x,I5)' do i=1,size(n) @@ -963,30 +1266,30 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E !...................................................... if (n(Indx_x) > 0) then WRITE(Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) WRITE(Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true. ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) end if if (n(Indx_xd) > 0) then WRITE(Un, '(A)') 'Order of discrete states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd ) end if if (n(Indx_z) > 0) then WRITE(Un, '(A)') 'Order of constraint states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, rotFrame=LinData%RotFrame_z ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, rotFrame=LinData%RotFrame_z ) end if if (n(Indx_u) > 0) then WRITE(Un, '(A)') 'Order of inputs:' - call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) + call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) end if if (n(Indx_y) > 0) then WRITE(Un, '(A)') 'Order of outputs:' - call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) + call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) end if !............. @@ -1031,7 +1334,7 @@ SUBROUTINE WrLinFile_txt_End(Un, p_FAST, LinData) END SUBROUTINE WrLinFile_txt_End !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, UseCol,start_indx) +SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, derivOrder, UseCol,start_indx) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters INTEGER(IntKi), INTENT(IN ) :: Un !< unit number @@ -1040,6 +1343,7 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, U CHARACTER(LinChanLen), INTENT(IN ) :: names(:) !< Descriptions of the channels (names and units) logical, optional, INTENT(IN ) :: rotFrame(:) !< determines if this parameter is in the rotating frame logical, optional, intent(in ) :: deriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) + integer(IntKi), optional, intent(in ) :: derivOrder(:) !< Order of the time derivatives associated with the channel logical, optional, intent(in ) :: UseCol(:) !< flags that tell us if we should use each column or skip it INTEGER(IntKi),optional, INTENT(IN ) :: start_indx !< starting index (so extended inputs can be numbered starting after the # of inputs) @@ -1051,6 +1355,7 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, U logical :: UseDerivNames !< flag that tells us if we need to modify the channel names for derivatives (xdot) logical :: UseThisCol !< flag that tells us if we should use this particular column or skip it logical :: RotatingCol !< flag that tells us if this column is in the rotating frame + integer(IntKi) :: DerivOrdCol !< integer indicating the maximum time-derivative order of a channel (this will be 0 for anything that is not a continuous state) CHARACTER(*), PARAMETER :: RoutineName = 'WrLinFile_txt_Table' CHARACTER(100) :: Fmt CHARACTER(100) :: Fmt_Str @@ -1067,12 +1372,12 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, U TS = 14 + 3*p_FAST%FmtWidth+7 ! tab stop after operating point - Fmt = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',T'//trim(num2lstr(TS))//',L8,8x,A)' - FmtOrient = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',2(", ",'//trim(p_FAST%OutFmt)//'),T'//trim(num2lstr(TS))//',L8,8x,A)' - Fmt_Str = '(3x,A10,1x,A,T'//trim(num2lstr(TS))//',A15,1x,A)' + Fmt = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',T'//trim(num2lstr(TS))//',L8,8x,I8,9x,A)' + FmtOrient = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',2(", ",'//trim(p_FAST%OutFmt)//'),T'//trim(num2lstr(TS))//',L8,8x,I8,9x,A)' + Fmt_Str = '(3x,A10,1x,A,T'//trim(num2lstr(TS))//',A15,1x,A16,1x,A)' - WRITE(Un, Fmt_Str) RowCol, 'Operating Point', 'Rotating Frame?','Description' - WRITE(Un, Fmt_Str) '----------','---------------', '---------------','-----------' + WRITE(Un, Fmt_Str) RowCol, 'Operating Point', 'Rotating Frame?', 'Derivative Order', 'Description' + WRITE(Un, Fmt_Str) '----------','---------------', '---------------', '----------------', '-----------' i_op = 1 if (present(start_indx)) then @@ -1086,14 +1391,17 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, U UseThisCol = .true. if (present(UseCol)) then UseThisCol = useCol(i) - end if + end if + + DerivOrdCol = 0 + if (present(derivOrder)) DerivOrdCol = derivOrder(i) RotatingCol = .false. if (present(rotFrame)) RotatingCol = rotFrame(i) if (index(names(i), ' orientation angle, node ') > 0 ) then ! make sure this matches what is written in PackMotionMesh_Names() if (UseThisCol) then - WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, trim(names(i)) !//' [OP is a row of the DCM] + WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] i_print = i_print + 1 end if @@ -1101,15 +1409,15 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, U else if (UseThisCol) then if (UseDerivNames) then - WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, 'First time derivative of '//trim(names(i))//'/s' + WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, 'First time derivative of '//trim(names(i))//'/s' else - WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, trim(names(i)) + WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, trim(names(i)) end if i_print = i_print + 1 end if i_op = i_op + 1 - end if + end if end do WRITE (Un,'()' ) !print a blank line @@ -1134,7 +1442,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) INTEGER(IntKi) :: i_u ! loop/temp variables INTEGER(IntKi) :: i_y, i_x ! loop/temp variables INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'Glue_GetOP' @@ -1169,6 +1477,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%op_dx, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'op_dx', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return end if @@ -1202,6 +1511,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) i_x = i_x + 1; end do end if + end do end do @@ -1209,11 +1519,9 @@ END SUBROUTINE Glue_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the Jacobian for the glue-code input-output solves. -SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables @@ -1221,7 +1529,6 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data @@ -1251,7 +1558,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, INTEGER(IntKi) :: r_start, r_end ! row start/end of glue matrix INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'Glue_Jacobians' ErrStat = ErrID_None @@ -1282,7 +1589,8 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, !! 0 & 0 & 0 & 0 & \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \\ !! \end{bmatrix} \f$ !..................................... - +! LIN-TODO: Add doc strings for new modules: HD & MAP + if (.not. allocated(dUdu)) then call AllocAry(dUdu, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'dUdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1323,7 +1631,8 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{BD}} \end{bmatrix} = \f$ (dUdu block row 3=ED) !............ ! we need to do this for CompElast=ED and CompElast=BD - call Linear_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + + call Linear_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1331,18 +1640,31 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} \end{bmatrix} = \f$ (dUdu block row 4=BD) !............ IF (p_FAST%CompElast == Module_BD) THEN - call Linear_BD_InputSolve_du( p_FAST, y_FAST, ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_du( p_FAST, y_FAST, ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF - + !............ ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) !............ IF (p_FAST%CompAero == MODULE_AD) THEN - call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if ! we're using the InflowWind module - + end if + + IF (p_FAST%CompSub == Module_ExtPtfm) THEN + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO') + ENDIF + + !............ + ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial u^{HD}} \end{bmatrix} = \f$ (dUdu block row 6=HD) + !............ + IF (p_FAST%CompHydro == MODULE_HD) THEN + call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + ! LIN-TODO: Update the doc lines below to include HD and MAP !..................................... ! dUdy !> \f$ \frac{\partial U_\Lambda}{\partial y} = @@ -1379,13 +1701,15 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, call Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, dUdy ) end if + !............ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{SrvD}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{ED}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{BD}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 3=ED) !............ - call Linear_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1394,7 +1718,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 4=BD) !............ if (p_FAST%CompElast == MODULE_BD) then - call Linear_BD_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1409,12 +1733,32 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%Input(1), dUdy ) end if - call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if - - + +! LIN-TODO: Implement HD-related solve + !............ + ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 6=HD) + !............ + if (p_FAST%CompHydro == MODULE_HD) then + call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + +! LIN-TODO: Implement Map-related solve + !............ + ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 7=MAP) + !............ + if (p_FAST%CompMooring == MODULE_MAP) then + call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + IF (p_FAST%CompSub == Module_ExtPtfm) THEN + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO') + ENDIF END SUBROUTINE Glue_Jacobians !---------------------------------------------------------------------------------------------------------------------------------- @@ -1479,8 +1823,8 @@ SUBROUTINE Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, u_AD, dUdu ) 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, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - +SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, HD, MAPp, MeshMapData, dUdu, ErrStat, ErrMsg ) +!LIN-TODO: Augment this interface for HD and MAP TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t @@ -1488,18 +1832,20 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t - + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: i ! rows/columns INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: BD_Start ! starting index of dUdu (column) where BD root motion inputs are located INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located + INTEGER(IntKi) :: HD_Start + INTEGER(IntKi) :: MAP_Start INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -1519,19 +1865,11 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, ! ED inputs on blade from AeroDyn IF (p_FAST%CompElast == Module_ED) THEN - ! blades: - AD_Start_Bl = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) & - + u_AD%TowerMotion%NNodes * 9 & ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - + u_AD%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components - - do k = 1,size(u_AD%BladeRootMotion) - AD_Start_Bl = AD_Start_Bl + u_AD%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components - end do - ! next is u_AD%BladeMotion(k); note that it has 3 fields and we only need 1 - ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade + AD_Start_Bl = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) CALL Linearize_Line2_to_Point( y_AD%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1542,7 +1880,6 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, end if ! get starting index of next blade - AD_Start_Bl = AD_Start_Bl + u_AD%BladeMotion(k)%Nnodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes* 3 ! skip the moments on this blade END DO @@ -1552,15 +1889,8 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, ! ED inputs on tower from AD: IF ( y_AD%TowerLoad%Committed ) THEN - ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - if (allocated(u_ED%BladePtLoads)) then - do i=1,size(u_ED%BladePtLoads) - ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(i)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade - end do - end if - ED_Start_mt = ED_Start_mt + u_ED%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node - + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) - + ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & + + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) CALL Linearize_Line2_to_Point( y_AD%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%TowerMotion, y_ED%TowerLn2Mesh ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1579,12 +1909,8 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, !.......... IF ( p_FAST%CompElast == Module_BD ) THEN ! see routine U_ED_SD_HD_BD_Orca_Residual() in SolveOption1 - - ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - ! u_ED%BladePtLoads(i)%NNodes = 0 here - ED_Start_mt = ED_Start_mt + u_ED%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node - + u_ED%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + u_ED%HubPtLoad%NNodes * 3 ! 3 forces at the hub (so we start at the moments) + ED_Start_mt = Indx_u_ED_Hub_Start(u_ED, y_FAST) & + + u_ED%HubPtLoad%NNodes * 3 ! 3 forces at the hub (so we start at the moments) ! Transfer BD loads to ED hub input: ! we're mapping loads, so we also need the sibling meshes' displacements: @@ -1602,8 +1928,63 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, end do ! k END IF + + !.......... + ! dU^{ED}/du^{HD} + !.......... + + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} + + ! we're just going to assume u_ED%PlatformPtMesh is committed + + if ( HD%y%AllHdroOrigin%Committed ) then ! meshes for floating + 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 HD load outputs to ED PlatformPtMesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + HD_Start = Indx_u_HD_PlatformRef_Start(HD%Input(1), y_FAST) + + call Linearize_Point_to_Point( HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%HD_W_P_2_ED_P%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_ED_P%dM%m_us, ED_Start_mt, HD_Start ) + end if + + end if + end if + + !.......... + ! dU^{ED}/du^{MAP} + !.......... + ! LIN-TODO: Implement + if ( p_FAST%CompMooring == Module_MAP ) 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 MAP loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one MAP Fairlead point + + CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_P_2_ED_P%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_ED_P%dM%m_us, ED_Start_mt, MAP_Start ) + end if + + end if END SUBROUTINE Linear_ED_InputSolve_du + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs !! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. @@ -1754,7 +2135,7 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, ! tower IF (u_AD%TowerMotion%Committed) THEN - + CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) @@ -1788,16 +2169,9 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, END IF - ! index for u_AD%BladeMotion(1)%translationDisp field - AD_Start_td = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) & - + u_AD%TowerMotion%NNodes * 9 & ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - + u_AD%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components - - do k = 1,size(u_AD%BladeRootMotion) - AD_Start_td = AD_Start_td + u_AD%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components - end do DO k=1,size(u_AD%BladeMotion) + AD_Start_td = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for u_AD%BladeMotion(k)%translationDisp field !AD is the destination here, so we need tv_ud if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then @@ -1807,9 +2181,6 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) end if - ! index for u_AD%BladeMotion(k+1)%translationDisp field - AD_Start_td = AD_Start_td + u_AD%BladeMotion(k)%NNodes * 9 ! 3 fields (TranslationDisp, Orientation, TranslationVel) with 3 components - END DO @@ -1825,17 +2196,18 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, dUdy ) REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{SrvD}/dy^{ED} block integer(intKi) :: ED_Start_Yaw !< starting index of dUdy (column) where ED Yaw/YawRate/HSS_Spd outputs are located (just before WriteOutput) - + integer(intKi) :: thisModule INTEGER(IntKi) :: i ! loop counter CHARACTER(*), PARAMETER :: RoutineName = 'Linear_SrvD_InputSolve_dy' - ED_Start_Yaw = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(Module_ED)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) - - y_FAST%Lin%Modules(Module_ED)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) - do i=1,3 - dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + i - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi + thisModule = Module_ED + ED_Start_Yaw = Indx_y_Yaw_Start(y_FAST, ThisModule) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + + do i=1,size(SrvD_Indx_Y_BlPitchCom) + dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + SrvD_Indx_Y_BlPitchCom(i) - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi end do !IF (u_SrvD%NTMD%Mesh%Committed) THEN @@ -1854,9 +2226,9 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, dUdy ) END SUBROUTINE Linear_SrvD_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, and dU^{ED}/dy^{AD} blocks of dUdy. (i.e., how do -!! changes in the SrvD, ED, BD, and AD outputs effect the ED inputs?) -SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) +!> 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, u_ED, y_ED, y_AD, u_AD, BD, HD, MAPp, 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) @@ -1865,6 +2237,8 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP 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 @@ -1872,13 +2246,15 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables + !LIN-TODO: Add comments INTEGER(IntKi) :: i ! rows/columns INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where particular BD fields are located INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located - + INTEGER(IntKi) :: HD_Out_Start + INTEGER(IntKi) :: MAP_Out_Start CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' @@ -1893,10 +2269,9 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, ! BlPitchCom, YawMom, GenTrq ED_Start = Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) do i=1,size(u_ED%BlPitchCom)+2 ! BlPitchCom, YawMom, GenTrq (NOT collective pitch) - dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi + dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi !SrvD_Indx_Y_BlPitchCom end do - !IF (y_SrvD%NTMD%Mesh%Committed) THEN ! CALL Linearize_Point_to_Point( y_SrvD%NTMD%Mesh, u_ED%NacelleLoads, MeshMapData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, u_SrvD%NTMD%Mesh, y_ED%NacelleMotion ) ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ED%NacelleLoads' ) @@ -1975,23 +2350,66 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubPtLoad%Moment field (skip forces) DO k=1,p_FAST%nBeams ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field - CALL SumBlockMatrix( dUdy, MeshMapData%BD_P_2_ED_P(k)%dM%m_ud, ED_Start, ED_Out_Start) + call SumBlockMatrix( dUdy, MeshMapData%BD_P_2_ED_P(k)%dM%m_ud, ED_Start, ED_Out_Start) END DO END IF -END SUBROUTINE Linear_ED_InputSolve_dy -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do -!! changes in the ED, BD, and AD outputs effect the BD inputs?) -SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) + ! HD + ! parts of dU^{ED}/dy^{HD} and dU^{ED}/dy^{ED}: + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} + + ! we're just going to assume u_ED%PlatformPtMesh is committed + + if ( HD%y%AllHdroOrigin%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! call Linearize_Point_to_Point( HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + HD_Out_Start = Indx_y_HD_AllHdro_Start(HD%y, y_FAST) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Moment field + call Assemble_dUdy_Loads(HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ED_Start, HD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMapData%HD_W_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) +! maybe this should be SumBlockMatrix with future changes to linearized modules??? + end if + + + end if + + ! MAP + ! parts of dU^{ED}/dy^{MAP} and dU^{ED}/dy^{ED}: + if ( p_FAST%CompMooring == Module_MAP ) then + if ( MAPp%y%ptFairleadLoad%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations + MAP_Out_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ED_Start, MAP_Out_Start, dUdy) + + ! ED 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 + +END SUBROUTINE Linear_ED_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do +!! changes in the ED, BD, and AD outputs effect the BD inputs?) +SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -2270,6 +2688,325 @@ SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMa END SUBROUTINE Linear_AD_InputSolve_NoIfW_dy !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/du^{HD} blocks of dUdu. +SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, 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(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/du^{HD} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: HD_Start_td ! starting index of dUdu (column) where particular HD fields are located + INTEGER(IntKi) :: HD_Start_tr ! starting index of dUdu (row) where particular HD fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_du' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine + ! We need to make six calls to SetBlockMatrix for the different output to input mappings + ! 1) Row 3, Col 1 + ! 2) Row 5, Col 1 + ! 3) Row 9, Col 7 + ! 4) Row 11, Col 7 + ! 5) Row 15, Col 13 + ! 6) Row 17, Col 13 + + ! look at how the translational displacement gets transfered to the translational velocity and translational acceleration: + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn: + !------------------------------------------------------------------------------------------------- + + !.......... + ! dU^{HD}/du^{HD} + ! note that the 1s on the diagonal have already been set, so we will fill in the off diagonal terms. + !.......... + + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} + + !=================================================== + ! y_ED%PlatformPtMesh and u_HD%Morison%DistribMesh + !=================================================== + + ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): + + call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + + HD_Start_td = y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + HD_Start_tr = HD_Start_td + u_HD%Morison%DistribMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_HD_M_L%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_M_L%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if + + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%Morison%DistribMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%ED_P_2_HD_M_L%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_M_L%dM%ta_ud, HD_Start_tr, HD_Start_td ) + end if + + !=================================================== + ! y_ED%PlatformPtMesh and u_HD%Morison%LumpedMesh + !=================================================== + + call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + HD_Start_td = HD_Start_tr + u_HD%Morison%DistribMesh%NNodes * 6 ! skip 1 field ( TranslationAcc and RotationAcc) + HD_Start_tr = HD_Start_td + u_HD%Morison%LumpedMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_HD_M_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_M_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if + + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%Morison%LumpedMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + + if (allocated(MeshMapData%ED_P_2_HD_M_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_M_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) + end if + + !=================================================== + ! y_ED%PlatformPtMesh and u_HD%Mesh + !=================================================== + + call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + HD_Start_td = HD_Start_tr + u_HD%Morison%LumpedMesh%NNodes * 6 ! skip 2 field ( TranslationalAcc and RotationAcc) + HD_Start_tr = HD_Start_td + u_HD%Mesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_HD_W_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_W_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if + + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%Mesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + + if (allocated(MeshMapData%ED_P_2_HD_W_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_W_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) + end if + + end if + + +END SUBROUTINE Linear_HD_InputSolve_du +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect +!! the HD inputs?) +SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, 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(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: HD_Start ! starting index of dUdy (column) where particular HD fields are located + INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !................................... + ! Distributed Morison Mesh + !................................... + IF (u_HD%Morison%DistribMesh%Committed) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + + HD_Start = Indx_u_HD_Distrib_Start(u_HD, y_FAST) ! start of u_HD%Morison%DistribMesh%TranslationDisp field + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, HD_Start, ED_Out_Start, dUdy, .false.) + END IF + + !................................... + ! Lumped Morison Mesh + !................................... + IF (u_HD%Morison%LumpedMesh%Committed) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + + HD_Start = Indx_u_HD_Lumped_Start(u_HD, y_FAST) ! start of u_HD%Morison%LumpedMesh%TranslationDisp field + + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, HD_Start, ED_Out_Start, dUdy, .false.) + END IF + + !................................... + ! Lumped Platform Reference Pt Mesh + !................................... + IF (u_HD%Mesh%Committed) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + + HD_Start = Indx_u_HD_PlatformRef_Start(u_HD, y_FAST) ! start of u_HD%Mesh%TranslationDisp field + + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, HD_Start, ED_Out_Start, dUdy, .false.) + + END IF + + +END SUBROUTINE Linear_HD_InputSolve_dy + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{MAP}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect +!! the MAP inputs?) +SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, 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(MAP_InputType), INTENT(INOUT) :: u_MAP !< The inputs to MAP + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MAP}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: MAP_Start ! starting index of dUdy (column) where particular MAP fields are located + INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MAP_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !................................... + ! FairLead Mesh + !................................... + IF (u_MAP%PtFairDisplacement%Committed) THEN + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + + call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, MAP_Start, ED_Out_Start, dUdy, OnlyTranslationDisp=.true.) + + + END IF + +END SUBROUTINE Linear_MAP_InputSolve_dy + +! LIN-TODO: Clean up if not used. +!!---------------------------------------------------------------------------------------------------------------------------------- +!!> This routine forms the dU^{MAP}/dy^{ED} blocks of dUdu. +!SUBROUTINE Linear_MAP_InputSolve_du( p_FAST, y_FAST, u_MAP, y_ED, 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(HD_InputType), INTENT(INOUT) :: u_MAP !< The inputs to HydroDyn + +! TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module +! TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules +! REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MAP}/dy^{ED} block +! +! INTEGER(IntKi) :: ErrStat !< Error status of the operation +! CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None +! +! ! Local variables: +! +! INTEGER(IntKi) :: MAP_Start ! starting index of dUdy (column) where particular MAP fields are located +! INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where particular ED fields are located +! INTEGER(IntKi) :: ErrStat2 +! CHARACTER(ErrMsgLen) :: ErrMsg2 +! CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MAP_InputSolve_dy' +! +! +! ErrStat = ErrID_None +! ErrMsg = "" +! +! ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine +! ! We need to make six calls to SetBlockMatrix for the different output to input mappings +! ! 1) Row 3, Col 1 +! ! 2) Row 4, Col 1 +! +! +! ! look at how the translational displacement gets transfered to the translational velocity and translational acceleration: +! !------------------------------------------------------------------------------------------------- +! ! Set the inputs from ElastoDyn: +! !------------------------------------------------------------------------------------------------- +! +! !.......... +! ! dU^{MAP}/dy^{ED} +! ! note that the 1s on the diagonal have already been set, so we will fill in the off diagonal terms. +! !.......... +! +! if ( p_FAST%CompMooring == Module_MAP ) then ! MAP- ElastoDyn +! +! !=================================================== +! ! y_ED%PlatformPtMesh and u_MAP%Morison%DistribMesh +! !=================================================== +! +! ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): +! +! call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_MAP%Morison%DistribMesh, MeshMapData%ED_P_2_MAP_M_L, ErrStat2, ErrMsg2 ) +! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +! +! ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} +! +! HD_Start_td = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) +! HD_Start_tr = HD_Start_td + u_MAP%Morison%DistribMesh%%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field +! +! ! translational velocity: +! if (allocated(MeshMapData%ED_P_2_MAP_M_L%dM%tv_uD )) then +! call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_MAP_M_L%dM%tv_ud, HD_Start_tr, HD_Start_td ) +! end if +! +! ! translational acceleration: +! HD_Start_tr = HD_Start_tr + u_MAP%Morison%DistribMesh%%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) +! if (allocated(MeshMapData%ED_P_2_MAP_M_L%dM%ta_uD )) then +! call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_MAP_M_L%dM%ta_ud, HD_Start_tr, HD_Start_td ) +! end if +! +! end if +! +! +!END SUBROUTINE Linear_MAP_InputSolve_du + +!---------------------------------------------------------------------------------------------------------------------------------- + !> This routine allocates the state matrices for the glue code and concatenates the module-level state matrices into !! the first step of computing the full system state matrices. This routine returns !! \f$ A = A^{ED} \f$, \f$ B = \begin{bmatrix} 0 & 0 & B^{ED} & 0 \end{bmatrix} \f$, @@ -2296,7 +3033,7 @@ SUBROUTINE Glue_FormDiag( p_FAST, y_FAST, ErrStat, ErrMsg ) INTEGER(IntKi) :: c_start ! column in glue matrix where module block matrix starts INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'Glue_FormDiag' ErrStat = ErrID_None @@ -2443,7 +3180,7 @@ SUBROUTINE Glue_StateMatrices( p_FAST, y_FAST, dUdu, dUdy, ErrStat, ErrMsg ) INTEGER(IntKi), ALLOCATABLE :: ipiv(:) INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'Glue_StateMatrices' ErrStat = ErrID_None @@ -2541,9 +3278,9 @@ SUBROUTINE Glue_StateMatrices( p_FAST, y_FAST, dUdu, dUdy, ErrStat, ErrMsg ) ! A !---------------------- !> \f{equation}{ A = - !! \begin{bmatrix} A^{ED} & 0 \\ 0 & A^{BD} \end{bmatrix} - - !! \begin{bmatrix} 0 & 0 & B^{ED} & 0 & 0 \\ 0 & 0 & 0 & B^{BD} & 0\end{bmatrix} \, - !! \begin{bmatrix} G \end{bmatrix}^{-1} \, \frac{\partial U}{\partial y} \, \begin{bmatrix} 0 & 0 \\ 0 & 0 \\ C^{ED} & 0 \\ 0 & C^{BD} \\ 0 & 0 \end{bmatrix} + !! \begin{bmatrix} A^{ED} & 0 & 0 \\ 0 & A^{BD} & 0 \\ 0 & 0 & A^{HD}\end{bmatrix} - + !! \begin{bmatrix} 0 & 0 & B^{ED} & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & B^{BD} & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & B^{HD}\end{bmatrix} \, + !! \begin{bmatrix} G \end{bmatrix}^{-1} \, \frac{\partial U}{\partial y} \, \begin{bmatrix} 0 & 0 & 0 \\ 0 & 0 & 0 \\ C^{ED} & 0 & 0 \\ 0 & C^{BD} & 0 \\ 0 & 0 & 0 \\ 0 & 0 & C^{HD} \\ 0 & 0 & 0\end{bmatrix} !! \f} !y_FAST%Lin%Glue%A = y_FAST%Lin%Glue%A - matmul( y_FAST%Lin%Glue%B, tmp ) call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, y_FAST%Lin%Glue%B, tmp, 1.0_R8Ki, y_FAST%Lin%Glue%A, ErrStat2, ErrMsg2 ) @@ -2762,7 +3499,7 @@ END SUBROUTINE SumBlockMatrix !! \vec{a}^S \\ !! \vec{\alpha}^S \\ !! \end{matrix} \right\} \f$ -SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, skipRotVel) +SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, skipRotVel, onlyTranslationDisp) TYPE(MeshType), INTENT(IN) :: y !< the output (source) mesh that is transfering motions TYPE(MeshType), INTENT(IN) :: u !< the input (destination) mesh that is receiving motions TYPE(MeshMapType), INTENT(IN) :: MeshMap !< the mesh mapping from y to u @@ -2770,6 +3507,7 @@ SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dU INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< full Jacobian matrix LOGICAL, OPTIONAL, INTENT(IN) :: skipRotVel !< if present and true, we skip the rotational velocity and acceleration fields and return early + LOGICAL, OPTIONAL, INTENT(IN) :: onlyTranslationDisp !< if present and true, we set only the destination translationDisp fields and return early INTEGER(IntKi) :: row INTEGER(IntKi) :: col @@ -2794,6 +3532,11 @@ SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dU call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + if (PRESENT(onlyTranslationDisp)) then + if (onlyTranslationDisp) return ! destination includes only the translational displacement field, so we'll just return + end if + + !*** row for orientation *** ! source orientation to destination orientation: row = BlockRowStart + u%NNodes*3 ! start of u%Orientation field [skip 1 field with 3 components] @@ -2894,12 +3637,14 @@ SUBROUTINE Assemble_dUdy_Loads(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] col = BlockColStart ! start of y%Force field call SetBlockMatrix( dUdy, MeshMap%dM%m_f, row, col ) - - ! source moment to moment: - row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] - col = BlockColStart + y%NNodes*3 ! start of y%Moment field [skip 1 field with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%li, row, col ) - + + if (allocated(y%Moment)) then + ! source moment to destination moment: + row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] + col = BlockColStart + y%NNodes*3 ! start of y%Moment field [skip 1 field with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%li, row, col ) + end if + END SUBROUTINE Assemble_dUdy_Loads @@ -3044,6 +3789,19 @@ FUNCTION Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) end do END FUNCTION Indx_y_ED_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for y_ED%Yaw in the FAST linearization outputs. +FUNCTION Indx_y_Yaw_Start(y_FAST, ThisModule) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + INTEGER, INTENT(IN ) :: ThisModule !< which structural module this is for + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + + ED_Out_Start = y_FAST%Lin%Modules(thisModule)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(thisModule)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) + - y_FAST%Lin%Modules(thisModule)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + +END FUNCTION Indx_y_Yaw_Start +!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_AD%TowerMotion mesh in the FAST linearization inputs. @@ -3111,5 +3869,1753 @@ FUNCTION Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) RESULT(AD_Start) END FUNCTION Indx_u_AD_BladeInflow_Start !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%Morison%DistribMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_HD_Distrib_Start(u_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(IN ) :: u_HD !< HD Inputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = y_FAST%Lin%Modules(Module_HD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + +END FUNCTION Indx_u_HD_Distrib_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%Morison%LumpedMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_HD_Lumped_Start(u_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(IN ) :: u_HD !< HD Inputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = Indx_u_HD_Distrib_Start(u_HD, y_FAST) + if (u_HD%Morison%DistribMesh%committed) HD_Start = HD_Start + u_HD%Morison%DistribMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components + +END FUNCTION Indx_u_HD_Lumped_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%Mesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_HD_PlatformRef_Start(u_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(IN ) :: u_HD !< HD Inputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = Indx_u_HD_Lumped_Start(u_HD, y_FAST) + if (u_HD%Morison%LumpedMesh%committed) HD_Start = HD_Start + u_HD%Morison%LumpedMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components + + END FUNCTION Indx_u_HD_PlatformRef_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_HD%Morison%DistribMesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_HD_Distrib_Start(y_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HD Outputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn Outputs + + HD_Start = y_FAST%Lin%Modules(Module_HD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + +END FUNCTION Indx_y_HD_Distrib_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_HD%Morison%LumpedMesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_HD_Lumped_Start(y_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HD Outputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn Outputs + + HD_Start = Indx_y_HD_Distrib_Start(y_HD, y_FAST) + if (y_HD%Morison%DistribMesh%committed) HD_Start = HD_Start + y_HD%Morison%DistribMesh%NNodes * 6 ! 2 fields (MASKID_FORCE,MASKID_MOMENT) with 3 components + +END FUNCTION Indx_y_HD_Lumped_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_HD%Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_HD_PlatformRef_Start(y_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HD Outputs at t + + INTEGER :: HD_Start + + !< starting index of this mesh in HydroDyn Outputs + + HD_Start = Indx_y_HD_Lumped_Start(y_HD, y_FAST) + if (y_HD%Morison%LumpedMesh%committed) HD_Start = HD_Start + y_HD%Morison%LumpedMesh%NNodes * 6 ! 2 fields (MASKID_FORCE,MASKID_MOMENT) with 3 components + + END FUNCTION Indx_y_HD_PlatformRef_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_HD%AllHdroOrigin mesh in the FAST linearization outputs. +FUNCTION Indx_y_HD_AllHdro_Start(y_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HD Outputs at t + + INTEGER :: HD_Start + + !< starting index of this mesh in HydroDyn Outputs + + HD_Start = Indx_y_HD_PlatformRef_Start(y_HD, y_FAST) + if (y_HD%Mesh%committed) HD_Start = HD_Start + y_HD%Mesh%NNodes * 6 ! 2 fields (MASKID_FORCE,MASKID_MOMENT) with 3 components + +END FUNCTION Indx_y_HD_AllHdro_Start + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine allocates the arrays that store the operating point at each linearization time for later producing VTK +!! files of the mode shapes. +SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(*), PARAMETER :: RoutineName = 'AllocateOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + + ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + + IF ( p_FAST%CompElast == Module_BD ) THEN + ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + ! if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + +END SUBROUTINE AllocateOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is the inverse of SetOperatingPoint(). It saves the current operating points so they can be retrieved +!> when visualizing mode shapes. +SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, CtrlCode ) + + INTEGER(IntKi) , INTENT(IN ) :: i !< current index into LinTimes + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(IN ) :: CtrlCode !< mesh copy control code (new, vs update) + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SaveOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy states and inputs to OP array + CALL ED_CopyContState (ED%x( STATE_CURR), y_FAST%op%x_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), y_FAST%op%xd_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), y_FAST%op%z_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), y_FAST%op%OtherSt_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (ED%Input(1), y_FAST%op%u_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy states and inputs to OP array + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_CURR), y_FAST%op%x_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), y_FAST%op%xd_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), y_FAST%op%z_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (BD%Input(1,k), y_FAST%op%u_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + + + ! AeroDyn: copy states and inputs to OP array + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (AD%x( STATE_CURR), y_FAST%op%x_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), y_FAST%op%xd_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), y_FAST%op%z_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (AD%Input(1), y_FAST%op%u_AD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy states and inputs to OP array + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), y_FAST%op%x_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), y_FAST%op%xd_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), y_FAST%op%z_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt( STATE_CURR), y_FAST%op%OtherSt_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (IfW%Input(1), y_FAST%op%u_IfW(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy states and inputs to OP array + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), y_FAST%op%x_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), y_FAST%op%xd_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), y_FAST%op%z_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), y_FAST%op%OtherSt_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (SrvD%Input(1), y_FAST%op%u_SrvD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy states and inputs to OP array + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), y_FAST%op%x_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), y_FAST%op%xd_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), y_FAST%op%z_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (HD%Input(1), y_FAST%op%u_HD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), y_FAST%op%x_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), y_FAST%op%xd_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), y_FAST%op%z_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), y_FAST%op%OtherSt_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), y_FAST%op%u_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (MAPp%x( STATE_CURR), y_FAST%op%x_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), y_FAST%op%xd_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), y_FAST%op%z_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MAP(i), CtrlCode, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + 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 ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), y_FAST%op%xd_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), y_FAST%op%z_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + 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 ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), y_FAST%op%xd_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), y_FAST%op%z_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), y_FAST%op%OtherSt_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (FEAM%Input(1), y_FAST%op%u_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), y_FAST%op%x_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), y_FAST%op%xd_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), y_FAST%op%z_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), y_FAST%op%OtherSt_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (IceF%Input(1), y_FAST%op%u_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (IceD%x( k,STATE_CURR), y_FAST%op%x_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(k,STATE_CURR), y_FAST%op%xd_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( k,STATE_CURR), y_FAST%op%z_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (IceD%Input(1,k), y_FAST%op%u_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + +END SUBROUTINE SaveOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine takes arrays representing the eigenvector of the states and uses it to modify the operating points for +!! continuous states. It is highly tied to the module organizaton. +SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t + INTEGER(IntKi), INTENT(IN ) :: iLinTime !< index into LinTimes dimension of arrays (azimuth) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + INTEGER(IntKi) :: i ! generic loop counters + INTEGER(IntKi) :: j ! generic loop counters + INTEGER(IntKi) :: indx ! generic loop counters + INTEGER(IntKi) :: indx_last ! generic loop counters + INTEGER(IntKi) :: i_x ! index into packed array + INTEGER(IntKi) :: nStates ! number of second-order states + INTEGER(IntKi) :: ThisModule ! identifier of current module + + CHARACTER(*), PARAMETER :: RoutineName = 'PerturbOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + i_x = 1 + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x) ! use this for the loop because ED may have a larger op_x_eig_mag array than op_x + + ! this is a hack because not all modules pack the continuous states in the same way: + if (ThisModule == Module_ED) then + if (j<= ED%p%DOFs%NActvDOF) then + indx = ED%p%DOFs%PS(j) + else + indx = ED%p%DOFs%PS(j-ED%p%DOFs%NActvDOF) + ED%p%NDOF + end if + else + indx = j + end if + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx) = p_FAST%VTK_modes%x_eig_magnitude(i_x, iLinTime, iMode) ! this is going to hold the magnitude of the eigenvector + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(indx) = p_FAST%VTK_modes%x_eig_phase( i_x, iLinTime, iMode) ! this is going to hold the phase of the eigenvector + i_x = i_x + 1; + end do + end if + + end do + end do + + + + ! ElastoDyn: + ThisModule = Module_ED + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)/2 + + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QDT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + + ! BeamDyn: + IF ( p_FAST%CompElast == Module_BD ) THEN + ThisModule = Module_BD + DO k=1,p_FAST%nBeams + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)/2 + + indx = 1 + do i=2,BD%p(k)%node_total + indx_last = indx + BD%p(k)%dof_node - 1 + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%q( :,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx:indx_last ), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase( indx:indx_last )) + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%dqdt(:,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag(nStates+indx:indx_last+nStates), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(nStates+indx:indx_last+nStates)) + indx = indx_last+1 + end do + + end if + + END DO + END IF + + + !!! ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !!!!IF ( p_FAST%CompAero == Module_AD14 ) THEN + !!!!ELSE + !!!IF ( p_FAST%CompAero == Module_AD ) THEN + !!!END IF + !!! + !!!! InflowWind: copy op to actual states and inputs + !!!IF ( p_FAST%CompInflow == Module_IfW ) THEN + !!!END IF + !!! + !!! + !!!! ServoDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompServo == Module_SrvD ) THEN + !!!END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + ThisModule = Module_HD + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = HD%p%WAMIT%SS_Exctn%N + if (nStates > 0) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT%SS_Exctn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + end if + if (nStates < size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT%SS_Rdtn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + end if + END IF + + + !!!! SubDyn: copy final predictions to actual states + !!!IF ( p_FAST%CompSub == Module_SD ) THEN + !!!ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !!!END IF + !!! + !!! + !!!! MAP/MoorDyn/FEAM: copy op to actual states and inputs + !!!IF (p_FAST%CompMooring == Module_MAP) THEN + !!!ELSEIF (p_FAST%CompMooring == Module_MD) THEN + !!!ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + !!!!ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + !!!END IF + !!! + !!! ! IceFloe/IceDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompIce == Module_IceF ) THEN + !!!ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + !!! DO k=1,p_FAST%numIceLegs + !!! END DO + !!!END IF + + +END SUBROUTINE PerturbOP +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: i !< Index into LinTimes (to determine which operating point to copy) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetOperatingPoint' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + ! ElastoDyn: copy op to actual states and inputs + CALL ED_CopyContState (y_FAST%op%x_ED( i), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (y_FAST%op%xd_ED( i), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (y_FAST%op%z_ED( i), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (y_FAST%op%OtherSt_ED( i), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (y_FAST%op%u_ED( i), ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy op to actual states and inputs + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (y_FAST%op%x_BD(k, i), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (y_FAST%op%xd_BD(k, i), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (y_FAST%op%z_BD(k, i), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (y_FAST%op%OtherSt_BD(k, i), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (y_FAST%op%u_BD(k, i), BD%Input(1, k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (y_FAST%op%x_AD( i), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (y_FAST%op%xd_AD( i), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (y_FAST%op%z_AD( i), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (y_FAST%op%OtherSt_AD( i), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (y_FAST%op%u_AD(i), AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy op to actual states and inputs + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (y_FAST%op%x_IfW( i), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (y_FAST%op%xd_IfW( i), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (y_FAST%op%z_IfW( i), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (y_FAST%op%OtherSt_IfW( i), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (y_FAST%op%u_IfW(i), IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy op to actual states and inputs + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (y_FAST%op%x_SrvD( i), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (y_FAST%op%xd_SrvD( i), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (y_FAST%op%z_SrvD( i), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (y_FAST%op%OtherSt_SrvD( i), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (y_FAST%op%u_SrvD(i), SrvD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (y_FAST%op%x_HD( i), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (y_FAST%op%xd_HD( i), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (y_FAST%op%z_HD( i), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (y_FAST%op%OtherSt_HD( i), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (y_FAST%op%u_HD(i), HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (y_FAST%op%x_ExtPtfm(i), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (y_FAST%op%xd_ExtPtfm(i), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (y_FAST%op%z_ExtPtfm(i), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (y_FAST%op%OtherSt_ExtPtfm(i), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (y_FAST%op%u_ExtPtfm(i), ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy op to actual states and inputs + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (y_FAST%op%x_MAP(i), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (y_FAST%op%xd_MAP(i), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (y_FAST%op%z_MAP(i), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (y_FAST%op%OtherSt_MAP(i), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (y_FAST%op%u_MAP(i), MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (y_FAST%op%x_MD(i), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (y_FAST%op%xd_MD(i), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (y_FAST%op%z_MD(i), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (y_FAST%op%OtherSt_MD(i), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (y_FAST%op%u_MD(i), MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (y_FAST%op%x_FEAM(i), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (y_FAST%op%xd_FEAM(i), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (y_FAST%op%z_FEAM(i), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (y_FAST%op%OtherSt_FEAM(i), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (y_FAST%op%u_FEAM(i), FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy op to actual states and inputs + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (y_FAST%op%x_IceF(i), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (y_FAST%op%xd_IceF(i), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (y_FAST%op%z_IceF(i), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (y_FAST%op%OtherSt_IceF(i), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (y_FAST%op%u_IceF(i), IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (y_FAST%op%x_IceD(k, i), IceD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (y_FAST%op%xd_IceD(k, i), IceD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (y_FAST%op%z_IceD(k, i), IceD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (y_FAST%op%OtherSt_IceD(k, i), IceD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (y_FAST%op%u_IceD(k, i), IceD%Input(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + +END SUBROUTINE SetOperatingPoint +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine GetStateAry(p_FAST, iMode, t, x, x_eig_magnitude, x_eig_phase) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + REAL(DbKi) , INTENT(IN ) :: t !< time + REAL(R8Ki), INTENT(INOUT) :: x(:) !< in: state at its operating point; out: added perturbation + REAL(R8Ki), INTENT(IN) :: x_eig_magnitude(:) !< magnitude of the eigenvector + REAL(R8Ki), INTENT(IN) :: x_eig_phase(:) !< phase of the eigenvector + + ! note that this assumes p_FAST%VTK_modes%VTKLinPhase is zero for VTKLinTim=2 + x = x + x_eig_magnitude * p_FAST%VTK_modes%VTKLinScale * cos( TwoPi_D * p_FAST%VTK_modes%DampedFreq_Hz(iMode)*t + x_eig_phase + p_FAST%VTK_modes%VTKLinPhase ) +end subroutine GetStateAry + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the algorithm for computing a periodic steady-state solution. +SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step + REAL(DbKi), INTENT(IN ) :: t_global ! current simulation time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: DeltaAzim + REAL(DbKi) :: psi !< psi (rotor azimuth) at which the outputs are defined + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + LOGICAL :: NextAzimuth + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CalcSteady' + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! get azimuth angle + + psi = ED%y%LSSTipPxa + call Zero2TwoPi( psi ) + + if (n_t_global == 0) then + ! initialize a few things on the first call: + call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + else + DeltaAzim = psi - m_FAST%Lin%Psi(1) + call Zero2TwoPi(DeltaAzim) + + if (DeltaAzim > p_FAST%AzimDelta) then + call SetErrStat(ErrID_Fatal, "The rotor is spinning too fast. The time step or NLinTimes is too large when CalcSteady=true.", ErrStat, ErrMsg, RoutineName) + return + end if + + ! save the outputs and azimuth angle for possible interpolation later + call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + if (ErrStat >= AbortErrLev) return + + + + if ( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) <= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) ) then ! the equal sign takes care of the zero-rpm case + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) + else + ! this is the 2pi boundary, so we are either larger than the last target azimuth or less than the next one + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) .and. psi < m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) + end if + + if (NextAzimuth) then + + ! interpolate to find y at the target azimuth + call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + if (m_FAST%Lin%IsConverged .or. m_FAST%Lin%n_rot == 0) then ! save this operating point for linearization later + m_FAST%Lin%LinTimes(m_FAST%Lin%AzimIndx) = t_global + call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + end if + + ! increment the counter to check the next azimuth: + m_FAST%Lin%AzimIndx = m_FAST%Lin%AzimIndx + 1 + + ! check if we've completed one rotor revolution + if (m_FAST%Lin%AzimIndx > p_FAST%NLinTimes) then + m_FAST%Lin%n_rot = m_FAST%Lin%n_rot + 1 + + m_FAST%Lin%FoundSteady = m_FAST%Lin%IsConverged + + if (.not. m_FAST%Lin%FoundSteady) then + ! compute the reference values for this rotor revolution + call ComputeOutputRanges(p_FAST, y_FAST, m_FAST, SrvD%y) + m_FAST%Lin%IsConverged = .true. ! check errors next rotor revolution + m_FAST%Lin%AzimIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY + end if + end if + + end if + + +END SUBROUTINE FAST_CalcSteady +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes variables for calculating periodic steady-state solution. +SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitSteadyOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + do j=1,p_FAST%NLinTimes + m_FAST%Lin%AzimTarget(j) = (j-1) * p_FAST%AzimDelta + psi + call Zero2TwoPi( m_FAST%Lin%AzimTarget(j) ) + end do + ! this is circular, so I am going to add points at the beginning and end to avoid + ! more IF statements later + m_FAST%Lin%AzimTarget(0) = m_FAST%Lin%AzimTarget(p_FAST%NLinTimes) + m_FAST%Lin%AzimTarget(p_FAST%NLinTimes+1) = m_FAST%Lin%AzimTarget(1) + + + ! Azimuth angles that correspond to Output arrays for interpolation: + !m_FAST%Lin%Psi = psi ! initialize entire array (note that we won't be able to interpolate with a constant array + DO j = 1, p_FAST%LinInterpOrder + 1 + m_FAST%Lin%Psi(j) = psi - (j - 1) * D2R_D ! arbitrarily say azimuth is one degree different + END DO + + + ! ElastoDyn + allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + do j = 1, p_FAST%LinInterpOrder + 1 + call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end do + + allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end if + + end if + + END IF ! BeamDyn + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + allocate( AD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating AD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call AD_CopyOutput(AD%y, AD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call AD_CopyOutput(AD%y, AD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + allocate( IfW%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating IfW%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call InflowWind_CopyOutput(IfW%y, IfW%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call InflowWind_CopyOutput(IfW%y, IfW%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + allocate( SrvD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SrvD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SrvD_CopyOutput(SrvD%y, SrvD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SrvD_CopyOutput(SrvD%y, SrvD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + allocate( HD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating HD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call HydroDyn_CopyOutput(HD%y, HD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call HydroDyn_CopyOutput(HD%y, HD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + allocate( MAPp%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating MAPp%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call MAP_CopyOutput(MAPp%y, MAPp%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call MAP_CopyOutput(MAPp%y, MAPp%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_InitSteadyOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine saves outputs for future interpolation at a desired azimuth. +SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SaveOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + DO j = p_FAST%LinInterpOrder, 1, -1 + m_FAST%Lin%Psi(j+1) = m_FAST%Lin%Psi(j) + END DO + + if (psi < m_FAST%Lin%Psi(1)) then + ! if we go around a 2pi boundary, we will subtract 2pi from the saved values so that interpolation works as expected + m_FAST%Lin%Psi = m_FAST%Lin%Psi - TwoPi_D + end if + m_FAST%Lin%Psi(1) = psi + + ! ElastoDyn + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL AD_CopyOutput (AD%Output(j), AD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL AD_CopyOutput (AD%y, AD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL InflowWind_CopyOutput (IfW%Output(j), IfW%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL InflowWind_CopyOutput (IfW%y, IfW%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL SrvD_CopyOutput (SrvD%Output(j), SrvD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL SrvD_CopyOutput (SrvD%y, SrvD%Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + + CALL HydroDyn_CopyOutput (HD%Output(j), HD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL HydroDyn_CopyOutput (HD%y, HD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MAP_CopyOutput (MAPp%Output(j), MAPp%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + 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 + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_SaveOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores +!! them for future rotation . +SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi_target !< psi (rotor azimuth) at which the outputs are requested + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + 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 counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(DbKi) :: t_global + REAL(ReKi) :: eps_squared + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DiffInterpOutputs' + + ErrStat = ErrID_None + ErrMsg = "" + t_global = 0.0_DbKi ! we don't really need this to get the output OPs + + !................................................................................................ + ! Extrapolate outputs to the target azimuth and pack into OP arrays + !................................................................................................ + + ! ElastoDyn + CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedLogMap=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedLogMap=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + CALL AD_Output_ExtrapInterp (AD%Output, m_FAST%Lin%Psi, AD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), & + AD%y_interp, AD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + CALL InflowWind_Output_ExtrapInterp (IfW%Output, m_FAST%Lin%Psi, IfW%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & + IfW%y_interp, IfW%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + CALL SrvD_Output_ExtrapInterp (SrvD%Output, m_FAST%Lin%Psi, SrvD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & + SrvD%y_interp, SrvD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + CALL HydroDyn_Output_ExtrapInterp (HD%Output, m_FAST%Lin%Psi, HD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y_interp, HD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + CALL MAP_Output_ExtrapInterp (MAPp%Output, m_FAST%Lin%Psi, MAPp%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y_interp, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + + call pack_in_array(p_FAST, y_FAST, m_FAST) + + if (m_FAST%Lin%IsConverged) then + ! check that error equation is less than TrimTol !!!call + call calc_error(p_FAST, y_FAST, m_FAST, SrvD%y, eps_squared) + m_FAST%Lin%IsConverged = eps_squared < p_FAST%TrimTol + end if + + + m_FAST%Lin%Y_prevRot(:,m_FAST%Lin%AzimIndx) = m_FAST%Lin%y_interp + +END SUBROUTINE FAST_DiffInterpOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE pack_in_array(p_FAST, y_FAST, m_FAST) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + m_FAST%Lin%y_interp( indx ) = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%op_y(j) + end do + + end do + end do + +END SUBROUTINE pack_in_array +!---------------------------------------------------------------------------------------------------------------------------------- +!> This function computes the error function between this rotor revolution and the previous one. +!! Angles represented in m_FAST%Lin%y_interp may have 2pi added or subtracted to allow the angles to be closer to the previous +!! rotor revolution. +SUBROUTINE calc_error(p_FAST, y_FAST, m_FAST, y_SrvD, eps_squared) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + REAL(ReKi) ,INTENT( OUT) :: eps_squared !< epsilon squared + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + real(ReKi) :: diff + + + ! special cases for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + end do + end if + + + ! compute the error: + eps_squared = 0.0_ReKi + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + if (EqualRealNos(m_FAST%Lin%y_interp( indx ), m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ))) then + diff = 0.0_ReKi ! take care of some potential numerical issues + else + diff = m_FAST%Lin%y_interp( indx ) - m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ) + end if + + eps_squared = eps_squared + ( diff / m_FAST%Lin%y_ref( indx ) ) ** 2 + end do + + end do + end do + + + !................................. + ! Normalize: + !................................. + eps_squared = eps_squared / ( y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Glue%NumOutputs ) + +! write(50+m_FAST%Lin%AzimIndx,'(3000(F15.7,1x))') m_FAST%Lin%y_interp, eps_squared +END SUBROUTINE calc_error +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ComputeOutputRanges(p_FAST, y_FAST, m_FAST, y_SrvD) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + + integer :: indx + integer :: i + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) + m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) + m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) +! if (m_FAST%Lin%y_ref(indx) < 1.0e-4) m_FAST%Lin%y_ref(indx) = 1.0_ReKi ! not sure why we wouldn't just do m_FAST%Lin%y_ref(indx) = max(1.0_ReKi, m_FAST%Lin%y_ref(indx)) or max(1e-4, y_ref(indx)) + end do + + ! special case for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + end do + end if + + ! Note: I'm ignoring the periodicity of the log maps that represent orientations + +END SUBROUTINE ComputeOutputRanges +!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE FAST_Linear \ No newline at end of file +END MODULE FAST_Linear diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 2d5e1bffb3..f528ae815d 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -42,6 +42,7 @@ MODULE FAST_ModTypes INTEGER(IntKi), PARAMETER :: VTK_None = 0 !< none (no VTK output) INTEGER(IntKi), PARAMETER :: VTK_InitOnly = 1 !< VTK output only at initialization INTEGER(IntKi), PARAMETER :: VTK_Animate = 2 !< VTK animation output + INTEGER(IntKi), PARAMETER :: VTK_ModeShapes = 3 !< VTK output after linearization analysis INTEGER(IntKi), PARAMETER :: VTK_Surf = 1 !< output surfaces INTEGER(IntKi), PARAMETER :: VTK_Basic = 2 !< output minimal number of point/line meshes diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 701df1f6fa..d599f93262 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -70,6 +70,22 @@ typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveE typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m typedef ^ FAST_VTK_SurfaceType SiKi MorisonRad {:} - - "radius of each Morison node" m + +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) CheckpointRoot - - - "name of the checkpoint file written by FAST when linearization data was produced" +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) MatlabFileName - - - "name of the file with eigenvectors written by Matlab" +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinModes - - - "Number of modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKModes {:} - - "Which modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinTim - - - "Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKNLinTimes - - - "number of linearization times to use when VTKLinTim==2" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinScale - - - "Mode shape visualization scaling factor" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinPhase - - - "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampingRatio {:} - - "damping ratios from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki NaturalFreq_Hz {:} - - "natural frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampedFreq_Hz {:} - - "damped frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - "magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - + + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: typedef FAST FAST_ParameterType DbKi DT - - - "Integration time step [global time]" s @@ -116,13 +132,14 @@ typedef ^ FAST_ParameterType DbKi DT_Out - - - "Time step for tabular output" s typedef ^ FAST_ParameterType LOGICAL WrSttsTime - - - "Whether we should write the status times to the screen" - typedef ^ FAST_ParameterType INTEGER n_SttsTime - - - "Number of time steps between screen status messages" - typedef ^ FAST_ParameterType INTEGER n_ChkptTime - - - "Number of time steps between writing checkpoint files" - +typedef ^ FAST_ParameterType INTEGER n_DT_Out - - - "Number of time steps between writing a line in the time-marching output files" - typedef ^ FAST_ParameterType INTEGER n_VTKTime - - - "Number of time steps between writing VTK files" - typedef ^ FAST_ParameterType IntKi TurbineType - - - "Type_LandBased, Type_Offshore_Fixed, or Type_Offshore_Floating" - typedef ^ FAST_ParameterType LOGICAL WrBinOutFile - - - "Write a binary output file? (.outb)" - typedef ^ FAST_ParameterType LOGICAL WrTxtOutFile - - - "Write a text (formatted) output file? (.out)" - typedef ^ FAST_ParameterType IntKi WrBinMod - - - "If writing binary, which file format is to be written [1, 2, or 3]" - typedef ^ FAST_ParameterType LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - -typedef ^ FAST_ParameterType INTEGER WrVTK - - - "VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}" - +typedef ^ FAST_ParameterType INTEGER WrVTK - 0 - "VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}" - typedef ^ FAST_ParameterType INTEGER VTK_Type - - - "Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)}" - typedef ^ FAST_ParameterType LOGICAL VTK_fields - - - "Write mesh fields to VTK data files? (flag) {true/false}" - typedef ^ FAST_ParameterType CHARACTER(1) Delim - - - "Delimiter between columns of text output file (.out): space or tab" - @@ -132,17 +149,117 @@ typedef ^ FAST_ParameterType IntKi FmtWidth - - - "width of the time OutFmt spec typedef ^ FAST_ParameterType IntKi TChanLen - - - "width of the time channel" - typedef ^ FAST_ParameterType CHARACTER(1024) OutFileRoot - - - "The rootname of the output files" - typedef ^ FAST_ParameterType CHARACTER(1024) FTitle - - - "The description line from the FAST (glue-code) input file" - -typedef ^ FAST_ParameterType DbKi LinTimes {:} - - "List of times at which to linearize" s +typedef ^ FAST_ParameterType CHARACTER(1024) VTK_OutFileRoot - "''" - "The rootname of the VTK output files" - +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 +typedef ^ FAST_ParameterType LOGICAL CalcSteady - - - "Calculate a steady-state periodic operating point before linearization [unused if Linearize=False]" - +typedef ^ FAST_ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True]" - +typedef ^ FAST_ParameterType ReKi TrimTol - - - "Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True]" - +typedef ^ FAST_ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ FAST_ParameterType ReKi Twr_Kdmp - - - "Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True]" "N/(m/s)" +typedef ^ FAST_ParameterType ReKi Bld_Kdmp - - - "Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True]" "N/(m/s)" +typedef ^ FAST_ParameterType IntKi NLinTimes - - - "Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False]" - +typedef ^ FAST_ParameterType DbKi AzimDelta - - - "difference between two consecutive azimuth positions in CalcSteady algorithm" rad + typedef ^ FAST_ParameterType IntKi LinInputs - - - "Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType IntKi LinOutputs - - - "Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType LOGICAL LinOutJac - - - "Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2]" - typedef ^ FAST_ParameterType LOGICAL LinOutMod - - - "Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False]" - -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 FAST_VTK_ModeShapeType VTK_modes - - - "Data for VTK mode-shape visualization" typedef ^ FAST_ParameterType IntKi Lin_NumMods - - - "number of modules in the linearization" -typedef ^ FAST_ParameterType Integer Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" -typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" +typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" +typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - +#typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - + + +# SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) +# ..... IceDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave IceD_ContinuousStateType x_IceD {:}{:} - - "Continuous states" +typedef ^ ^ IceD_DiscreteStateType xd_IceD {:}{:} - - "Discrete states" +typedef ^ ^ IceD_ConstraintStateType z_IceD {:}{:} - - "Constraint states" +typedef ^ ^ IceD_OtherStateType OtherSt_IceD {:}{:} - - "Other states" +typedef ^ ^ IceD_InputType u_IceD {:}{:} - - "System inputs" +# ..... BeamDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave BD_ContinuousStateType x_BD {:}{:} - - "Continuous states" +typedef ^ ^ BD_DiscreteStateType xd_BD {:}{:} - - "Discrete states" +typedef ^ ^ BD_ConstraintStateType z_BD {:}{:} - - "Constraint states" +typedef ^ ^ BD_OtherStateType OtherSt_BD {:}{:} - - "Other states" +typedef ^ ^ BD_InputType u_BD {:}{:} - - "System inputs" +# ..... ElastoDyn OP data ..................................................................................................... +typedef FAST FAST_LinStateSave ED_ContinuousStateType x_ED {:} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd_ED {:} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z_ED {:} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt_ED {:} - - "Other states" +typedef ^ ^ ED_InputType u_ED {:} - - "System inputs" +# ..... ServoDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave SrvD_ContinuousStateType x_SrvD {:} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd_SrvD {:} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z_SrvD {:} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt_SrvD {:} - - "Other states" +typedef ^ ^ SrvD_InputType u_SrvD {:} - - "System inputs" +# ..... No AeroDyn14 data ..................................................................................................... +# ..... AeroDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave AD_ContinuousStateType x_AD {:} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd_AD {:} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z_AD {:} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt_AD {:} - - "Other states" +typedef ^ ^ AD_InputType u_AD {:} - - "System inputs" +# ..... InflowWind OP data ....................................................................................................... +typedef FAST FAST_LinStateSave InflowWind_ContinuousStateType x_IfW {:} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd_IfW {:} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z_IfW {:} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt_IfW {:} - - "Other states" +typedef ^ ^ InflowWind_InputType u_IfW {:} - - "System inputs" +# ..... No OpenFOAM integration data ....................................................................................................... +# ..... SubDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave SD_ContinuousStateType x_SD {:} - - "Continuous states" +typedef ^ ^ SD_DiscreteStateType xd_SD {:} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z_SD {:} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt_SD {:} - - "Other states" +typedef ^ ^ SD_InputType u_SD {:} - - "System inputs" +# ..... ExtPtfm OP data ....................................................................................................... +typedef FAST FAST_LinStateSave ExtPtfm_ContinuousStateType x_ExtPtfm {:} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd_ExtPtfm {:} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z_ExtPtfm {:} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt_ExtPtfm {:} - - "Other states" +typedef ^ ^ ExtPtfm_InputType u_ExtPtfm {:} - - "System inputs" +# ..... HydroDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave HydroDyn_ContinuousStateType x_HD {:} - - "Continuous states" +typedef ^ ^ HydroDyn_DiscreteStateType xd_HD {:} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z_HD {:} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt_HD {:} - - "Other states" +typedef ^ ^ HydroDyn_InputType u_HD {:} - - "System inputs" +# ..... IceFloe OP data ....................................................................................................... +typedef FAST FAST_LinStateSave IceFloe_ContinuousStateType x_IceF {:} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd_IceF {:} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z_IceF {:} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt_IceF {:} - - "Other states" +typedef ^ ^ IceFloe_InputType u_IceF {:} - - "System inputs" +# ..... MAP OP data ....................................................................................................... +typedef FAST FAST_LinStateSave MAP_ContinuousStateType x_MAP {:} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd_MAP {:} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z_MAP {:} - - "Constraint states" +#typedef ^ ^ MAP_OtherStateType OtherSt_MAP {:} - - "Other states" +typedef ^ ^ MAP_InputType u_MAP {:} - - "System inputs" +# ..... FEAMooring OP data ....................................................................................................... +typedef FAST FAST_LinStateSave FEAM_ContinuousStateType x_FEAM {:} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd_FEAM {:} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z_FEAM {:} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt_FEAM {:} - - "Other states" +typedef ^ ^ FEAM_InputType u_FEAM {:} - - "System inputs" +# ..... MoorDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave MD_ContinuousStateType x_MD {:} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd_MD {:} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z_MD {:} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt_MD {:} - - "Other states" +typedef ^ ^ MD_InputType u_MD {:} - - "System inputs" +# ..... NO OrcaFlex OP data ....................................................................................................... # ..... FAST_LinType data ....................................................................................................... typedef FAST FAST_LinType CHARACTER(LinChanLen) Names_u {:} - - "Names of the linearized inputs" @@ -156,6 +273,8 @@ typedef ^ FAST_LinType ReKi op_x {:} - - "continuous state operating point" typedef ^ FAST_LinType ReKi op_dx {:} - - "1st time derivative of continuous state operating point" typedef ^ FAST_LinType ReKi op_xd {:} - - "discrete state operating point" typedef ^ FAST_LinType ReKi op_z {:} - - "constraint state operating point" +typedef ^ FAST_LinType R8Ki op_x_eig_mag {:} - - "continuous state eigenvector magnitude" +typedef ^ FAST_LinType R8Ki op_x_eig_phase {:} - - "continuous state eigenvector phase" typedef ^ FAST_LinType Logical Use_u {:} - - "array same size as names_u, which indicates if this input is used in linearization output file" typedef ^ FAST_LinType Logical Use_y {:} - - "array same size as names_y, which indicates if this output is used in linearization output file" typedef ^ FAST_LinType R8Ki A {:}{:} - - "A matrix" @@ -170,18 +289,36 @@ typedef ^ FAST_LinType Logical RotFrame_u {:} - - "Whether corresponding input i typedef ^ FAST_LinType Logical RotFrame_y {:} - - "Whether corresponding output is in rotating frame" typedef ^ FAST_LinType Logical RotFrame_x {:} - - "Whether corresponding continuous state is in rotating frame" typedef ^ FAST_LinType Logical RotFrame_z {:} - - "Whether corresponding constraint state is in rotating frame" +typedef ^ FAST_LinType IntKi DerivOrder_x {:} - - "Derivative order for continuous states" typedef ^ FAST_LinType IntKi SizeLin {3} - - "sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states" - typedef ^ FAST_LinType IntKi LinStartIndx {3} - - "the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states" - typedef ^ FAST_LinType IntKi NumOutputs - - - "number of WriteOutputs in each linearized module" - -# ..... FAST_ModLinType data ....................................................................................................... +# ..... FAST_ModLinType data (for output) ........................................................................................... typedef ^ FAST_ModLinType FAST_LinType Instance {:} - - "Linearization data for each module instance (e.g., 3 blades for BD)" # ..... FAST_LinFileType data ....................................................................................................... typedef FAST FAST_LinFileType FAST_ModLinType Modules {NumModules} - - "Linearization data for each module" typedef ^ FAST_LinFileType FAST_LinType Glue - - - "Linearization data for the glue code (coupled system)" typedef ^ FAST_LinFileType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ FAST_LinFileType ReKi Azimuth - - - +typedef ^ FAST_LinFileType ReKi Azimuth - - - "Rotor azimuth position" rad +typedef ^ FAST_LinFileType ReKi WindSpeed - - - "Wind speed at reference height" m/s + + +# ..... FAST_MiscLinType data ....................................................................................................... +typedef ^ FAST_MiscLinType DbKi LinTimes {:} - - "List of times at which to linearize" s +typedef ^ FAST_MiscLinType IntKi CopyOP_CtrlCode - - - "mesh control code for copy type (new on first call; update otherwise)" - +typedef ^ FAST_MiscLinType DbKi AzimTarget {:} - - "target azimuth positions in CalcSteady algorithm" rad +typedef ^ FAST_MiscLinType logical IsConverged - - - "whether the error calculation in the CalcSteady algorithm is converged" - +typedef ^ FAST_MiscLinType logical FoundSteady - - - "whether the CalcSteady algorithm found a steady-state solution" - +typedef ^ FAST_MiscLinType IntKi n_rot - - - "number of rotations completed in CalcSteady algorithm" - +typedef ^ FAST_MiscLinType IntKi AzimIndx - - - "index into target azimuth array in CalcSteady algorithm" - +typedef ^ FAST_MiscLinType IntKi NextLinTimeIndx - - - "index for next time in LinTimes where linearization should occur" - +typedef ^ FAST_MiscLinType DbKi Psi {:} - - "Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines" - +typedef ^ FAST_MiscLinType ReKi y_interp {:} - - "Interpolated outputs packed into an array" - +typedef ^ FAST_MiscLinType ReKi y_ref {:} - - "Reference output range for CalcSteady error calculation" - +typedef ^ FAST_MiscLinType ReKi Y_prevRot {:}{:} - - "Linearization outputs from previous rotor revolution at each target azimuth " - + # ..... FAST_OutputFileType data ....................................................................................................... typedef FAST FAST_OutputFileType DbKi TimeData {:} - - "Array to contain the time output data for the binary file (first output time and a time [fixed] increment)" @@ -197,9 +334,13 @@ typedef ^ FAST_OutputFileType CHARACTER(ChanLen) ChannelNames {:} - - "Names of typedef ^ FAST_OutputFileType CHARACTER(ChanLen) ChannelUnits {:} - - "Units for the output channels" typedef ^ FAST_OutputFileType ProgDesc Module_Ver {NumModules} - - "version information from all modules" typedef ^ FAST_OutputFileType CHARACTER(ChanLen) Module_Abrev {NumModules} - - "abbreviation for module (used in file output naming conventions)" +typedef ^ FAST_OutputFileType LOGICAL WriteThisStep - - - "Whether this step will be written in the FAST output files" typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written (for naming output files)" typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave array" - typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" +typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - +typedef ^ FAST_OutputFileType CHARACTER(30) OutFmt_a - - - "Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces" - +typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" # ..... IceDyn data ....................................................................................................... @@ -227,6 +368,8 @@ typedef ^ ^ BD_ParameterType p {:} - - "Parameters" typedef ^ ^ BD_InputType u {:} - - "System inputs" typedef ^ ^ BD_OutputType y {:} - - "System outputs" typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" +typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" @@ -239,7 +382,8 @@ typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with InputTimes" +typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -253,6 +397,8 @@ typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" typedef ^ ^ SrvD_MiscVarType m - - - "Misc (optimization) variables not associated with time" +typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -277,6 +423,8 @@ typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -289,6 +437,8 @@ typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -336,6 +486,8 @@ typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -360,6 +512,8 @@ typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" typedef ^ ^ MAP_OutputType y - - - "System outputs" typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (copied for the case of subcycling)" +typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -444,7 +598,7 @@ typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_IceF_P - - - "Map SubDyn y2Mesh typedef ^ FAST_ModuleMapType MeshMapType IceD_P_2_SD_P {:} - - "Map IceDyn point mesh to SubDyn y2Mesh point mesh" typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_IceD_P {:} - - "Map SubDyn y2Mesh point mesh to IceDyn point mesh" # Stored Jacobians: -typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or ED_SD_HD_BD_InputOutputSolve" +typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve" typedef ^ FAST_ModuleMapType Integer Jacobian_pivot {:} - - "Pivot array used for LU decomposition of Jacobian_Opt1" typedef ^ FAST_ModuleMapType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" # Temporary copies of input meshes (stored here so we don't have to keep allocating/destroying them) @@ -465,12 +619,50 @@ typedef ^ FAST_ModuleMapType MeshType u_ExtPtfm_PtfmMesh - - - "copy of ExtPtfm_ # ..... 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" -typedef ^ FAST_ExternInputType ReKi YawPosCom - - - "yaw position command from Simulink/Labview" +typedef ^ FAST_ExternInputType ReKi YawPosCom - - 2pi "yaw position command from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi YawRateCom - - - "yaw rate command from Simulink/Labview" -typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - - "blade pitch commands from Simulink/Labview" "rad/s" +typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - 2pi "blade pitch commands from Simulink/Labview" "rad" typedef ^ FAST_ExternInputType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" typedef ^ FAST_ExternInputType ReKi LidarFocus 3 - - "lidar focus (relative to lidar location)" m + +# ..... FAST_InitData data ....................................................................................................... +typedef ^ FAST_InitData ED_InitInputType InData_ED - - - "ED Initialization input data" +typedef ^ FAST_InitData ED_InitOutputType OutData_ED - - - "ED Initialization output data" +typedef ^ FAST_InitData BD_InitInputType InData_BD - - - "BD Initialization input data" +typedef ^ FAST_InitData BD_InitOutputType OutData_BD : - - "BD Initialization output data" +typedef ^ FAST_InitData SrvD_InitInputType InData_SrvD - - - "SrvD Initialization input data" +typedef ^ FAST_InitData SrvD_InitOutputType OutData_SrvD - - - "SrvD Initialization output data" +typedef ^ FAST_InitData AD14_InitInputType InData_AD14 - - - "AD14 Initialization input data" +typedef ^ FAST_InitData AD14_InitOutputType OutData_AD14 - - - "AD14 Initialization output data" +typedef ^ FAST_InitData AD_InitInputType InData_AD - - - "AD Initialization input data" +typedef ^ FAST_InitData AD_InitOutputType OutData_AD - - - "AD Initialization output data" +typedef ^ FAST_InitData InflowWind_InitInputType InData_IfW - - - "IfW Initialization input data" +typedef ^ FAST_InitData InflowWind_InitOutputType OutData_IfW - - - "IfW Initialization output data" +typedef ^ FAST_InitData OpFM_InitInputType InData_OpFM - - - "OpFM Initialization input data" +typedef ^ FAST_InitData OpFM_InitOutputType OutData_OpFM - - - "OpFM Initialization output data" +typedef ^ FAST_InitData HydroDyn_InitInputType InData_HD - - - "HD Initialization input data" +typedef ^ FAST_InitData HydroDyn_InitOutputType OutData_HD - - - "HD Initialization output data" +typedef ^ FAST_InitData SD_InitInputType InData_SD - - - "SD Initialization input data" +typedef ^ FAST_InitData SD_InitOutputType OutData_SD - - - "SD Initialization output data" +typedef ^ FAST_InitData ExtPtfm_InitInputType InData_ExtPtfm - - - "ExtPtfm Initialization input data" +typedef ^ FAST_InitData ExtPtfm_InitOutputType OutData_ExtPtfm - - - "ExtPtfm Initialization output data" +typedef ^ FAST_InitData MAP_InitInputType InData_MAP - - - "MAP Initialization input data" +typedef ^ FAST_InitData MAP_InitOutputType OutData_MAP - - - "MAP Initialization output data" +typedef ^ FAST_InitData FEAM_InitInputType InData_FEAM - - - "FEAM Initialization input data" +typedef ^ FAST_InitData FEAM_InitOutputType OutData_FEAM - - - "FEAM Initialization output data" +typedef ^ FAST_InitData MD_InitInputType InData_MD - - - "MD Initialization input data" +typedef ^ FAST_InitData MD_InitOutputType OutData_MD - - - "MD Initialization output data" +typedef ^ FAST_InitData Orca_InitInputType InData_Orca - - - "Orca Initialization input data" +typedef ^ FAST_InitData Orca_InitOutputType OutData_Orca - - - "Orca Initialization output data" +typedef ^ FAST_InitData IceFloe_InitInputType InData_IceF - - - "IceF Initialization input data" +typedef ^ FAST_InitData IceFloe_InitOutputType OutData_IceF - - - "IceF Initialization output data" +typedef ^ FAST_InitData IceD_InitInputType InData_IceD - - - "IceD Initialization input data" +typedef ^ FAST_InitData IceD_InitOutputType OutData_IceD - - - "IceD Initialization output data (each instance will have the same output channels)" +typedef ^ FAST_InitData SC_InitInputType InData_SC - - - "SC Initialization input data" +typedef ^ FAST_InitData SC_InitOutputType OutData_SC - - - "SC Initialization output data" + + # ..... FAST_MiscVarType data ....................................................................................................... typedef FAST FAST_MiscVarType DbKi TiLstPrn - - - "The simulation time of the last print (to file)" (s) typedef ^ FAST_MiscVarType DbKi t_global - - - "Current simulation time (for global/FAST simulation)" (s) @@ -483,7 +675,7 @@ typedef ^ FAST_MiscVarType INTEGER SimStrtTime {8} - - "Start time of simulation #typedef ^ FAST_MiscVarType IntKi n_t_global - - - "simulation time step, loop counter for global (FAST) simulation" (s) typedef ^ FAST_MiscVarType Logical calcJacobian - - - "Should we calculate Jacobians in Option 1?" (flag) typedef ^ FAST_MiscVarType FAST_ExternInputType ExternInput - - - "external input values" - -typedef ^ FAST_MiscVarType INTEGER NextLinTimeIndx - - - "index for next time in LinTimes where linearization should occur" - +typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearization analysis" - # ..... FAST External Initialization Input data ....................................................................................................... typedef ^ FAST_ExternInitType DbKi Tmax - -1 - "External code specified Tmax" s @@ -525,3 +717,4 @@ typedef ^ FAST_TurbineType OrcaFlex_Data Orca - - - "Data for the OrcaFlex inter typedef ^ FAST_TurbineType IceFloe_Data IceF - - - "Data for the IceFloe module" - typedef ^ FAST_TurbineType IceDyn_Data IceD - - - "Data for the IceDyn module" - typedef ^ FAST_TurbineType ExtPtfm_Data ExtPtfm - - - "Data for the ExtPtfm (external platform loading) module" - +#typedef ^ FAST_TurbineType FAST_InitData Init - - - "Data for all modules at initialization" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 2665514a49..c6ab8755fa 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -52,19 +52,26 @@ MODULE FAST_Solver !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for BD--using the Option 2 solve method; currently the only inputs solved in this routine !! are the blade distributed loads from AD15; other inputs are solved in option 1. -SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-BD load transfer) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables + REAL(R8Ki) :: omega_c(3) ! variable for adding damping + REAL(R8Ki) :: r(3) ! variable for adding damping + REAL(R8Ki) :: r_hub(3) ! variable for adding damping + REAL(R8Ki) :: Vrot(3) ! variable for adding damping + + INTEGER(IntKi) :: J ! Loops through blade nodes INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -115,7 +122,37 @@ SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) END IF - + ! add damping in blades for linearization convergence + if (p_FAST%CalcSteady) then + + ! note that this assumes sibling meshes for input and output + + omega_c = y_ED%RotSpeed * y_ED%HubPtMotion%Orientation(1,:,1) + r_hub = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + + if (p_FAST%BD_OutputSibling) then + + do k = 1,p_FAST%nBeams ! Loop through all blades + do j = 1,BD%Input(1,k)%DistrLoad%NNodes + r = BD%y(k)%BldMotion%Position(:,j) + BD%y(k)%BldMotion%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + BD%Input(1,k)%DistrLoad%Force(:,j) = BD%Input(1,k)%DistrLoad%Force(:,j) - p_FAST%Bld_Kdmp * ( BD%y(k)%BldMotion%TranslationVel(:,j) - Vrot ) + end do + end do + + else + + do k = 1,p_FAST%nBeams ! Loop through all blades + do j = 1,BD%Input(1,k)%DistrLoad%NNodes + r = MeshMapData%y_BD_BldMotion_4Loads(k)%Position(:,j) + MeshMapData%y_BD_BldMotion_4Loads(k)%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + BD%Input(1,k)%DistrLoad%Force(:,j) = BD%Input(1,k)%DistrLoad%Force(:,j) - p_FAST%Bld_Kdmp * ( MeshMapData%y_BD_BldMotion_4Loads(k)%TranslationVel(:,j) - Vrot ) + end do + end do + + end if + + end if END SUBROUTINE BD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- @@ -139,6 +176,11 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables + REAL(R8Ki) :: omega_c(3) ! variable for adding damping + REAL(R8Ki) :: r(3) ! variable for adding damping + REAL(R8Ki) :: r_hub(3) ! variable for adding damping + REAL(R8Ki) :: Vrot(3) ! variable for adding damping + INTEGER(IntKi) :: J ! Loops through nodes / elements INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation @@ -261,16 +303,41 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD u_ED%TwrAddedMass = 0.0_ReKi u_ED%PtfmAddedMass = 0.0_ReKi + + ! add damping in blades and tower for linearization convergence + if (p_FAST%CalcSteady) then + + ! note that this assumes sibling meshes for input and output (the ED bladeLn2Mesh has the same first same first BladePtLoads%NNodes nodes as BladePtLoads, so this is okay) + do j = 1,u_ED%TowerPtLoads%NNodes ! u_ED%TowerPtLoads%NNodes is two less than y_ED%TowerLn2Mesh%NNodes + u_ED%TowerPtLoads%Force(:,j) = u_ED%TowerPtLoads%Force(:,j) - p_FAST%Twr_Kdmp * y_ED%TowerLn2Mesh%TranslationVel(:,j) + end do + + IF (p_FAST%CompElast == Module_ED) THEN + omega_c = y_ED%RotSpeed * y_ED%HubPtMotion%Orientation(1,:,1) + r_hub = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + + do k=1,SIZE(u_ED%BladePtLoads,1) + do j = 1,u_ED%BladePtLoads(k)%NNodes + r = y_ED%BladeLn2Mesh(k)%Position(:,j) + y_ED%BladeLn2Mesh(k)%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + u_ED%BladePtLoads(k)%Force(:,j) = u_ED%BladePtLoads(k)%Force(:,j) - p_FAST%Bld_Kdmp * ( y_ED%BladeLn2Mesh(k)%TranslationVel(:,j) - Vrot ) + end do + end do + END IF + + end if + END SUBROUTINE ED_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- !> This routine determines the points in space where InflowWind needs to compute wind speeds. -SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, y_ED, ErrStat, ErrMsg ) +SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_AD, y_ED, ErrStat, ErrMsg ) - TYPE(InflowWind_InputType), INTENT(INOUT) :: u_IfW !< The inputs to InflowWind + TYPE(InflowWind_InputType), INTENT(INOUT) :: u_IfW(:) !< The inputs to InflowWind TYPE(InflowWind_ParameterType), INTENT(IN ) :: p_IfW !< The parameters to InflowWind TYPE(AD14_InputType), INTENT(IN) :: u_AD14 !< The input meshes (already calculated) from AeroDyn14 TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module + TYPE(AD_OtherStateType), INTENT(IN) :: OtherSt_AD !< The wake points from AeroDyn are in here (Free Vortex Wake) + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (for IfW Lidar) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< misc FAST data, including inputs from external codes like Simulink @@ -293,7 +360,7 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, y_ED, Err Node = 0 IF (p_FAST%CompServo == MODULE_SrvD) THEN Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = y_ED%HubPtMotion%Position(:,1) ! undisplaced position. Maybe we want to use the displaced position (y_ED%HubPtMotion%TranslationDisp) at some point in time. + u_IfW(1)%PositionXYZ(:,Node) = y_ED%HubPtMotion%Position(:,1) ! undisplaced position. Maybe we want to use the displaced position (y_ED%HubPtMotion%TranslationDisp) at some point in time. END IF IF (p_FAST%CompAero == MODULE_AD14) THEN @@ -301,13 +368,13 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, y_ED, Err DO K = 1,SIZE(u_AD14%InputMarkers) DO J = 1,u_AD14%InputMarkers(K)%nnodes !this mesh isn't properly set up (it's got the global [absolute] position and no reference position) Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD14%InputMarkers(K)%Position(:,J) + u_IfW(1)%PositionXYZ(:,Node) = u_AD14%InputMarkers(K)%Position(:,J) END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements END DO !K = 1,p%NumBl DO J=1,u_AD14%Twr_InputMarkers%nnodes Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD14%Twr_InputMarkers%TranslationDisp(:,J) + u_AD14%Twr_InputMarkers%Position(:,J) + u_IfW(1)%PositionXYZ(:,Node) = u_AD14%Twr_InputMarkers%TranslationDisp(:,J) + u_AD14%Twr_InputMarkers%Position(:,J) END DO ELSEIF (p_FAST%CompAero == MODULE_AD) THEN @@ -316,21 +383,31 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, y_ED, Err DO J = 1,u_AD%BladeMotion(k)%Nnodes Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%BladeMotion(k)%TranslationDisp(:,j) + u_AD%BladeMotion(k)%Position(:,j) + u_IfW(1)%PositionXYZ(:,Node) = u_AD%BladeMotion(k)%TranslationDisp(:,j) + u_AD%BladeMotion(k)%Position(:,j) END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements END DO !K = 1,p%NumBl DO J=1,u_AD%TowerMotion%nnodes - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD%TowerMotion%TranslationDisp(:,J) + u_AD%TowerMotion%Position(:,J) + Node = Node + 1 + u_IfW(1)%PositionXYZ(:,Node) = u_AD%TowerMotion%TranslationDisp(:,J) + u_AD%TowerMotion%Position(:,J) END DO - + ! vortex points from FVW in AD15 + if (allocated(OtherSt_AD%WakeLocationPoints)) then + do J=1,size(OtherSt_AD%WakeLocationPoints,DIM=2) + Node = Node + 1 + u_IfW(1)%PositionXYZ(:,Node) = OtherSt_AD%WakeLocationPoints(:,J) + ! rewrite the history of this so that extrapolation doesn't make a mess of things + do k=2,size(u_IfW) + if (allocated(u_IfW(k)%PositionXYZ)) u_IfW(k)%PositionXYZ(:,Node) = u_IfW(1)%PositionXYZ(:,Node) + end do + enddo + end if END IF - CALL IfW_SetExternalInputs( p_IfW, m_FAST, y_ED, u_IfW ) + CALL IfW_SetExternalInputs( p_IfW, m_FAST, y_ED, u_IfW(1) ) END SUBROUTINE IfW_InputSolve @@ -344,7 +421,6 @@ SUBROUTINE IfW_SetExternalInputs( p_IfW, m_FAST, y_ED, u_IfW ) TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module TYPE(InflowWind_InputType), INTENT(INOUT) :: u_IfW !< InflowWind Inputs at t - ! local variables ! bjj: this is a total hack to get the lidar inputs into InflowWind. We should use a mesh to take care of this messiness (and, really this Lidar Focus should come ! from Fortran (a scanning pattern or file-lookup inside InflowWind), not MATLAB. @@ -410,6 +486,15 @@ SUBROUTINE AD_InputSolve_IfW( p_FAST, u_AD, y_IfW, y_OpFM, ErrStat, ErrMsg ) node = node + 1 end do end if + ! velocity at vortex wake points velocity array handoff here + if ( allocated(u_AD%InflowWakeVel) ) then + Nnodes = size(u_AD%InflowWakeVel,DIM=2) + do j=1,Nnodes + u_AD%InflowWakeVel(:,j) = y_IfW%VelocityUVW(:,node) + node = node + 1 + end do + end if + ELSEIF ( p_FAST%CompInflow == MODULE_OpFM ) THEN node = 2 !start of inputs to AD15 @@ -516,8 +601,8 @@ SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, Err END IF - - + + ! Set Conrol parameter (i.e. flaps) if using ServoDyn ! bem: This takes in flap deflection for each blade (only one flap deflection angle per blade), ! from ServoDyn (which comes from Bladed style DLL controller) @@ -578,7 +663,7 @@ SUBROUTINE AD14_InputSolve_IfW( p_FAST, u_AD14, y_IfW, y_OpFM, ErrStat, ErrMsg ) END IF u_AD14%AvgInfVel = y_IfW%DiskVel - + END SUBROUTINE AD14_InputSolve_IfW !---------------------------------------------------------------------------------------------------------------------------------- @@ -721,7 +806,7 @@ SUBROUTINE AD14_InputSolve_NoIfW( p_FAST, u_AD14, y_ED, MeshMapData, ErrStat, Er END SUBROUTINE AD14_InputSolve_NoIfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ServoDyn -SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, MeshMapData, ErrStat, ErrMsg, y_SrvD_prev ) +SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters @@ -731,7 +816,6 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< InflowWind outputs TYPE(OpFM_OutputType), INTENT(IN) :: y_OpFM !< OpenFOAM outputs TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BD Outputs - TYPE(SrvD_OutputType), OPTIONAL, INTENT(IN) :: y_SrvD_prev !< ServoDyn outputs from t - dt TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -747,14 +831,9 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M ErrStat = ErrID_None ErrMsg = "" - ! ServoDyn inputs from combination of InflowWind and ElastoDyn - - u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw - - ! Calculate horizontal hub-height wind direction and the nacelle yaw error estimate (both positive about zi-axis); these are + ! Calculate horizontal hub-height wind direction (positive about zi-axis); these are ! zero if there is no wind input when InflowWind is not used: - - !bjj: rename pass YawAngle (not YawErr from ED) + IF ( p_FAST%CompInflow == Module_IfW ) THEN u_SrvD%WindDir = ATAN2( y_IfW%VelocityUVW(2,1), y_IfW%VelocityUVW(1,1) ) @@ -770,23 +849,22 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M if ( allocated(u_SrvD%SuperController) ) then u_SrvD%SuperController = y_OpFM%SuperController end if - - + ELSE ! No wind inflow u_SrvD%WindDir = 0.0 - u_SrvD%YawErr = 0.0 u_SrvD%HorWindV = 0.0 ENDIF - ! ServoDyn inputs from ServoDyn outputs at previous step - ! Jason says this violates the framework, but it's only for the Bladed DLL, which itself violates the framework, so I don't care. - IF (PRESENT(y_SrvD_prev)) THEN - u_SrvD%ElecPwr_prev = y_SrvD_prev%ElecPwr ! we want to know the electrical power from the previous time step (for the Bladed DLL) - u_SrvD%GenTrq_prev = y_SrvD_prev%GenTrq ! we want to know the electrical generator torque from the previous time step (for the Bladed DLL) - ! Otherwise, we'll use the guess provided by the module (this only happens at Step=0) - END IF + + + + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + + u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + ! ServoDyn inputs from ElastoDyn u_SrvD%Yaw = y_ED%Yaw !nacelle yaw @@ -805,8 +883,8 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M end do ELSE - u_SrvD%RootMxc = y_ED%RootMxc - u_SrvD%RootMyc = y_ED%RootMyc + u_SrvD%RootMxc = y_ED%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = y_ED%RootMyc ! fixed-size arrays: always size 3 END IF @@ -920,10 +998,10 @@ SUBROUTINE Transfer_SD_to_HD( y_SD, u_HD_M_LumpedMesh, u_HD_M_DistribMesh, MeshM END SUBROUTINE Transfer_SD_to_HD !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine transfers the ED outputs into inputs required for HD -SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) +!> This routine transfers the platform motion output of the structural module (ED) into inputs required for HD +SUBROUTINE Transfer_PlatformMotion_to_HD( PlatformMotion, u_HD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs of the structural dynamics module + TYPE(MeshType), INTENT(IN ) :: PlatformMotion !< The platform motion outputs of the structural dynamics module TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< HydroDyn input TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules @@ -933,6 +1011,7 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) ! local variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'Transfer_PlatformMotion_to_HD' ErrStat = ErrID_None @@ -946,8 +1025,8 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, ! hydrodynamic added mass - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Mesh)' ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) END IF !WAMIT @@ -955,20 +1034,20 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) IF ( u_HD%Morison%LumpedMesh%Committed ) THEN ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Morison%LumpedMesh)' ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%LumpedMesh)' ) END IF IF ( u_HD%Morison%DistribMesh%Committed ) THEN ! These are the motions for the line2 (distributed) loads associated viscous drag on the WAMIT body and/or filled/flooded distributed forces of the WAMIT body - CALL Transfer_Point_to_Line2( y_ED%PlatformPtMesh, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Morison%DistribMesh)' ) + CALL Transfer_Point_to_Line2( PlatformMotion, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%DistribMesh)' ) END IF -END SUBROUTINE Transfer_ED_to_HD +END SUBROUTINE Transfer_PlatformMotion_to_HD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine transfers the ED outputs into inputs required for HD, SD, ExtPtfm, BD, MAP, and/or FEAM SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, u_MAP, u_FEAM, u_MD, u_Orca, u_BD, MeshMapData, ErrStat, ErrMsg ) @@ -1004,19 +1083,25 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_SD%TPMesh' ) + IF ( p_FAST%CompHydro == Module_HD ) call TransferFixedBottomToHD() + ELSEIF ( p_FAST%CompSub == Module_ExtPtfm ) THEN ! Map ED (motion) outputs to ExtPtfm inputs: CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ExtPtfm%PtfmMesh' ) + IF ( p_FAST%CompHydro == Module_HD ) call TransferFixedBottomToHD() ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN ! Map ED outputs to HD inputs: - CALL Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_PlatformMotion_to_HD( y_ED%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) - END IF + END IF + + + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN ! map ED root and hub motion outputs to BeamDyn: @@ -1048,7 +1133,19 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_Orca%PtfmMesh' ) END IF - +contains + subroutine TransferFixedBottomToHD() + IF ( u_HD%Mesh%Committed ) THEN + + ! These are the motions for the lumped point loads associated the WAMIT body and include: hydrostatics, radiation memory effect, + ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, + ! hydrodynamic added mass + + CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) + + END IF !WAMIT + end subroutine END SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for MAP. @@ -1242,11 +1339,11 @@ END SUBROUTINE Transfer_ED_to_BD_tmp SUBROUTINE Transfer_HD_to_SD( u_mapped, u_SD_LMesh, u_mapped_positions, y_HD, u_HD_M_LumpedMesh, u_HD_M_DistribMesh, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(MeshType), INTENT(INOUT) :: u_mapped !< temporary copy of SD mesh (an argument to avoid another temporary mesh copy) - TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) + TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) TYPE(MeshType), INTENT(IN ) :: u_mapped_positions !< Mesh sibling of u_mapped, with displaced positions TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HydroDyn outputs - TYPE(MeshType), INTENT(IN ) :: u_HD_M_LumpedMesh !< HydroDyn input mesh (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) - TYPE(MeshType), INTENT(IN ) :: u_HD_M_DistribMesh !< HydroDyn input mesh (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) + TYPE(MeshType), INTENT(IN ) :: u_HD_M_LumpedMesh !< HydroDyn input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) + TYPE(MeshType), INTENT(IN ) :: u_HD_M_DistribMesh !< HydroDyn input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status @@ -1326,7 +1423,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED & , u_HD, p_HD, x_HD, xd_HD, z_HD, OtherSt_HD, y_HD, m_HD & , u_MAP, y_MAP, u_FEAM, y_FEAM, u_MD, y_MD & - , MeshMapData , ErrStat, ErrMsg ) + , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn @@ -1369,6 +1466,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? ! Local variables: INTEGER, PARAMETER :: NumInputs = SizeJac_ED_HD !12 @@ -1425,12 +1523,12 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Local copies for perturbing inputs and outputs (computing Jacobian): IF ( calcJacobian ) THEN CALL ED_CopyInput( u_ED, u_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOutput( y_ED, y_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOutput( y_ED, y_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyInput( u_HD, u_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CopyInput( u_HD, u_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOutput( y_HD, y_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CopyOutput( y_HD, y_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -1445,14 +1543,14 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! make hydrodyn inputs consistant with elastodyn outputs ! (do this because we're using outputs in the u vector): - CALL Transfer_ED_to_HD(y_ED_input, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD from y_ED_input - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_PlatformMotion_to_HD(y_ED_input%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD from y_ED_input + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - u( 1: 3) = u_ED%PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - u( 4: 6) = u_ED%PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact - u( 7: 9) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) - u(10:12) = y_ED_input%PlatformPtMesh%RotationAcc(:,1) + u( 1: 3) = u_ED%PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact + u( 4: 6) = u_ED%PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + u( 7: 9) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) + u(10:12) = y_ED_input%PlatformPtMesh%RotationAcc(:,1) K = 0 @@ -1519,7 +1617,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & !............................... ! Get HydroDyn's contribution: - !............................... + !............................... DO i=7,12 !call HD_CalcOutput ! we want to perturb u_HD, but we're going to perturb the input y_ED and transfer that to HD to get u_HD @@ -1527,7 +1625,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_perturb = u CALL Perturb_u( i, u_perturb, y_ED_perturb=y_ED_perturb, perturb=ThisPerturb ) ! perturb u and y_ED by ThisPerturb [routine sets ThisPerturb] - CALL Transfer_ED_to_HD( y_ED_perturb, u_HD_perturb, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD_perturb + CALL Transfer_PlatformMotion_to_HD( y_ED_perturb%PlatformPtMesh, u_HD_perturb, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD_perturb CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! calculate outputs with perturbed inputs: @@ -1544,7 +1642,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%Jacobian_Opt1(:,i) = (Fn_U_perturb - Fn_U_Resid) / ThisPerturb END DO ! HydroDyn contribution ( columns 7-12 ) - + #ifdef OUTPUT_ADDEDMASS UnAM = -1 CALL GetNewUnit( UnAM, ErrStat, ErrMsg ) @@ -1629,10 +1727,9 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & y_ED_input%PlatformPtMesh%TranslationAcc(:,1) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) + u_delta( 7: 9) y_ED_input%PlatformPtMesh%RotationAcc( :,1) = y_ED_input%PlatformPtMesh%RotationAcc( :,1) + u_delta(10:12) - CALL Transfer_ED_to_HD( y_ED_input, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD with u_delta changes + CALL Transfer_PlatformMotion_to_HD( y_ED_input%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD with u_delta changes CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - K = K + 1 END DO ! K @@ -1682,14 +1779,15 @@ END SUBROUTINE Perturb_u SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) !............................................................................................................................... - TYPE(ED_OutputType) , INTENT(IN ) :: y_ED2 ! System outputs + TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs REAL(ReKi) , INTENT(IN ) :: u_in(NumInputs) REAL(ReKi) , INTENT( OUT) :: U_Resid(NumInputs) - - + TYPE(MeshType), POINTER :: PlatformMotions + PlatformMotions => y_ED2%PlatformPtMesh + ! ! Transfer motions: !.................. @@ -1700,46 +1798,45 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL MAP_InputSolve( u_map, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_ED2%PlatformPtMesh ) !u_MAP and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) 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 MD_InputSolve( u_MD, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_MD%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 SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL FEAM_InputSolve( u_FEAM, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_FEAM and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE MeshMapData%u_ED_PlatformPtMesh_2%Force = 0.0_ReKi MeshMapData%u_ED_PlatformPtMesh_2%Moment = 0.0_ReKi - END IF + END IF ! we use copies of the input meshes (we don't need to update values in the original data structures): !bjj: why don't we update u_HD2 here? shouldn't we update before using it to transfer the loads? - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -1747,16 +1844,18 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) U_Resid( 1: 3) = u_in( 1: 3) - MeshMapData%u_ED_PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact - U_Resid( 7: 9) = u_in( 7: 9) - y_ED2%PlatformPtMesh%TranslationAcc(:,1) - U_Resid(10:12) = u_in(10:12) - y_ED2%PlatformPtMesh%RotationAcc(:,1) - + U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + + U_Resid( 7: 9) = u_in( 7: 9) - PlatformMotions%TranslationAcc(:,1) + U_Resid(10:12) = u_in(10:12) - PlatformMotions%RotationAcc(:,1) + + PlatformMotions => NULL() END SUBROUTINE U_ED_HD_Residual !............................................................................................................................... SUBROUTINE CleanUp() INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) CALL ED_DestroyOutput(y_ED_input, ErrStat3, ErrMsg3 ) IF (ErrStat3 /= ErrID_None) CALL WrScr(RoutineName//'/ED_DestroyOutput: '//TRIM(ErrMsg3) ) @@ -1793,7 +1892,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_MD, y_MD & , u_IceF, y_IceF & , u_IceD, y_IceD & - , MeshMapData , ErrStat, ErrMsg ) + , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn @@ -1815,7 +1914,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(ED_OtherStateType) , INTENT(IN ) :: OtherSt_ED !< Other states TYPE(ED_ParameterType) , INTENT(IN ) :: p_ED !< Parameters TYPE(ED_InputType) , INTENT(INOUT) :: u_ED !< System inputs - TYPE(ED_OutputType) , INTENT(INOUT) :: y_ED !< System outputs + TYPE(ED_OutputType), TARGET , INTENT(INOUT) :: y_ED !< System outputs TYPE(ED_MiscVarType) , INTENT(INOUT) :: m_ED !< misc/optimization variables !BeamDyn (one instance per blade): @@ -1884,6 +1983,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? ! Local variables: REAL(ReKi), PARAMETER :: TOL_Squared = (1.0E-4)**2 !not currently used because KMax = 1 @@ -1918,6 +2018,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + TYPE(MeshType), POINTER :: PlatformMotionMesh + #ifdef OUTPUT_ADDEDMASS REAL(ReKi) :: AddedMassMatrix(6,6) INTEGER :: UnAM @@ -1928,7 +2030,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER :: TmpIndx #endif - + LOGICAL :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput + ! Note: p_FAST%UJacSclFact is a scaling factor that gets us similar magnitudes between loads and accelerations... !bjj: note, that this routine may have a problem if there is remapping done @@ -2020,6 +2123,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & !------------------------------------------------------------------------------------------------- ! Calculate outputs at this_time, based on inputs at this_time !------------------------------------------------------------------------------------------------- + GetWriteOutput = WriteThisStep .and. K >= p_FAST%KMax ! we need this only on the last call to BD CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2038,9 +2142,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN do nb=1,p_FAST%nBeams - CALL BD_CalcOutput( this_time, u_BD(nb), p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD(nb), m_BD(nb), ErrStat2, ErrMsg2 ) + CALL BD_CalcOutput( this_time, u_BD(nb), p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD(nb), m_BD(nb), ErrStat2, ErrMsg2, GetWriteOutput ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do END IF @@ -2072,12 +2176,14 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END IF IF ( calcJacobian ) THEN + i = 0 !............................... ! Get ElastoDyn's contribution: !............................... - DO i=1,p_FAST%SizeJac_Opt1(2) !call ED_CalcOutput - + DO j=1,p_FAST%SizeJac_Opt1(2) !call ED_CalcOutput + i = i + 1 + ! perturb u_ED: CALL ED_CopyInput( u_ED, u_ED_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2101,7 +2207,6 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END DO ! ElastoDyn contribution ( columns 1-p_FAST%SizeJac_Opt1(2) ) - i = p_FAST%SizeJac_Opt1(2) !............................... ! Get SubDyn's contribution: (note if p_FAST%CompSub /= Module_SD, SizeJac_Opt1(3) = 0) !............................... @@ -2184,7 +2289,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL Perturb_u_FullOpt1( p_FAST, MeshMapData%Jac_u_indx, i, u_perturb, u_BD_perturb=u_BD_perturb, perturb=ThisPerturb ) ! perturb u and u_HD by ThisPerturb [routine sets ThisPerturb] ! calculate outputs with perturbed inputs: - CALL BD_CalcOutput( this_time, u_BD_perturb, p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD_perturb(nb), m_BD(nb), ErrStat2, ErrMsg2 ) + CALL BD_CalcOutput( this_time, u_BD_perturb, p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD_perturb(nb), m_BD(nb), ErrStat2, ErrMsg2, .false. ) ! We don't use the WriteOutput when computing the Jacobian CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL U_FullOpt1_Residual(y_ED, y_SD, y_HD, y_BD_perturb, y_Orca, y_ExtPtfm, u_perturb, Fn_U_perturb) ! get this perturbation @@ -2202,7 +2307,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & !............................... ! Get OrcaFlex's contribution: (note if p_FAST%CompMooring /= Module_Orca, SizeJac_Opt1(8) = 0) - !............................... + !............................... DO j=1,p_FAST%SizeJac_Opt1(8) !call Orca_CalcOutput i = i + 1 @@ -2436,6 +2541,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! This is effectively doing option 2, where we set the input velocities and displacements based on the outputs we just calculated !............................................... + PlatformMotionMesh => y_ED%PlatformPtMesh + + ! BD motion inputs: (from ED) IF (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN @@ -2485,12 +2593,12 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Map ED outputs to HD inputs (keeping the accelerations we just calculated): - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE - CALL Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_PlatformMotion_to_HD( PlatformMotionMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -2523,7 +2631,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_SD_TPMesh%RotationAcc = u_SD%TPMesh%RotationAcc MeshMapData%u_SD_TPMesh%TranslationAcc = u_SD%TPMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2539,7 +2647,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc = u_ExtPtfm%PtfmMesh%RotationAcc MeshMapData%u_ExtPtfm_PtfmMesh%TranslationAcc = u_ExtPtfm%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_ExtPtfm%PtfmMesh%RotationAcc = MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc @@ -2556,7 +2664,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_Orca_PtfmMesh%RotationAcc = u_Orca%PtfmMesh%RotationAcc MeshMapData%u_Orca_PtfmMesh%TranslationAcc = u_Orca%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_Orca%PtfmMesh%RotationAcc = MeshMapData%u_Orca_PtfmMesh%RotationAcc @@ -2574,7 +2682,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! transfer outputs of ED, HD, SD, BD, and OrcaFlex (and any additional loads that get summed with them) into inputs for ED, HD, SD, BD, and OrcaFlex !............................................................................................................................... - TYPE(ED_OutputType) , INTENT(IN ) :: y_ED2 ! System outputs + TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs TYPE(SD_OutputType) , INTENT(IN ) :: y_SD2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs TYPE(BD_OutputType) , INTENT(IN ) :: y_BD2(:) ! System outputs @@ -2584,6 +2692,9 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, REAL(ReKi) , INTENT( OUT) :: U_Resid(:) INTEGER(IntKi) :: i ! counter for ice leg and beamdyn loops + TYPE(MeshType), POINTER :: PlatformMotions + + PlatformMotions => y_ED2%PlatformPtMesh !.................. ! Set mooring line and ice inputs (which don't have acceleration fields and aren't used elsewhere in this routine, thus we're using the actual inputs (not a copy) @@ -2612,7 +2723,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Map ED motion output to Orca inputs: ! note: must be called before setting ED loads inputs (so that Orca motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF @@ -2673,7 +2784,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Map ED motion output to HD inputs: - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2741,7 +2852,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Motions (outputs) at ED platform ref point transfered to SD transition piece (input): - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_SD_TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_SD_TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2750,14 +2861,14 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Loads (outputs) on the SD transition piece transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, y_ED2%PlatformPtMesh ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, PlatformMotions ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! WAMIT loads from HD get added to this load: IF ( y_HD2%Mesh%Committed ) THEN ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh ) !u_SD contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_HD2%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions ) !u_SD contains the orientations 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 @@ -2772,7 +2883,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Motions (outputs) at ED platform ref point transfered to ExtPtfm PtfmMesh (input): - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_ExtPtfm_PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_ExtPtfm_PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2781,8 +2892,8 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Loads (outputs) on the ExtPtfm platform mesh transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, y_ED2%PlatformPtMesh ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, PlatformMotions ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSE IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -2791,24 +2902,24 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Map ED motion outputs to HD inputs: - ! basically, we want to call Transfer_ED_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) - ! CALL Transfer_ED_to_HD( y_ED2, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + ! basically, we want to call Transfer_PlatformMotion_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) + ! CALL Transfer_PlatformMotion_to_HD( y_ED2%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! so, here are the transfers, again. ! These are the motions for the lumped point loads associated the WAMIT body: - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body if (MeshMapData%u_HD_M_LumpedMesh%Committed) then - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_M_LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_M_LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) endif ! These are the motions for the line2 (distributed) loads associated viscous drag on the WAMIT body and/or filled/flooded distributed forces of the WAMIT body if (MeshMapData%u_HD_M_DistribMesh%Committed) then - CALL Transfer_Point_to_Line2( y_ED2%PlatformPtMesh, MeshMapData%u_HD_M_DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Line2( PlatformMotions, MeshMapData%u_HD_M_DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) endif @@ -2817,7 +2928,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSE @@ -2836,28 +2947,28 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Get the loads for ED from a mooring module and add them: IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_ED2%PlatformPtMesh ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations + 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 SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, y_ED2%PlatformPtMesh ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, PlatformMotions ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -2875,6 +2986,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, U_Resid = u_in - U_Resid + PlatformMotions => NULL() END SUBROUTINE U_FullOpt1_Residual !............................................................................................................................... @@ -2957,6 +3069,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP ErrMsg = "" ! determine how many inputs there are between the 6 modules (ED, SD, HD, BD, Orca, ExtPtfm) + p_FAST%SizeJac_Opt1 = 0 ! initialize whole array if (p_FAST%CompHydro == Module_HD .or. p_FAST%CompSub /= Module_None .or. p_FAST%CompMooring == Module_Orca) then p_FAST%SizeJac_Opt1(2) = ED_PlatformPtMesh%NNodes*6 ! ED inputs: 3 forces and 3 moments per node (only 1 node) @@ -2965,10 +3078,10 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP end if - p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) + p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) IF ( p_FAST%CompHydro == Module_HD ) THEN p_FAST%SizeJac_Opt1(3) = p_FAST%SizeJac_Opt1(3) & - + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) + + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) END IF p_FAST%SizeJac_Opt1(4) = HD_M_LumpedMesh%NNodes *6 & ! HD inputs: 6 accelerations per node (on each Morison mesh) @@ -2981,7 +3094,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP p_FAST%SizeJac_Opt1(5:7) = 0 ! assumes a max of 3 blades do k=1,size(u_BD) - p_FAST%SizeJac_Opt1(4+k) = u_BD(k)%RootMotion%NNodes *6 ! BD inputs: 6 accelerations per node (size of BD input from ED) + p_FAST%SizeJac_Opt1(4+k) = u_BD(k)%RootMotion%NNodes *6 ! BD inputs: 6 accelerations per node (size of BD input from ED) end do END IF @@ -3537,7 +3650,7 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u INTEGER( IntKi ) , INTENT(IN ) :: Jac_u_indx(:,:) !< Index to map Jacobian u-vector into mesh fields INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use REAL( ReKi ) , INTENT(INOUT) :: u_perturb(:) !< array to be perturbed - TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes) + TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes=NumEDNodes) TYPE(SD_InputType), OPTIONAL , INTENT(INOUT) :: u_SD_perturb !< SD System inputs (needed only when NumEDNodes +1 <= n <= NumEDNodes+NumSDNodes) [if SD is used] TYPE(HydroDyn_InputType), OPTIONAL , INTENT(INOUT) :: u_HD_perturb !< HD System inputs (needed only when NumEDNodes+NumSDNodes +1 <= n <= NumEDNodes+NumSDNodes+NumHDNodes) [if HD is used and SD is used. if SD not used, TYPE(BD_InputType), OPTIONAL , INTENT(INOUT) :: u_BD_perturb !< BD System inputs (needed only when NumEDNodes+NumSDNodes+NumHDNodes+1 <= n <= inf) [if BD is used] @@ -3673,23 +3786,23 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp ! ElastoDyn meshes ED%Input( 1)%PlatformPtMesh%RemapFlag = .FALSE. - ED%Output(1)%PlatformPtMesh%RemapFlag = .FALSE. + ED%y%PlatformPtMesh%RemapFlag = .FALSE. ED%Input( 1)%TowerPtLoads%RemapFlag = .FALSE. - ED%Output(1)%TowerLn2Mesh%RemapFlag = .FALSE. - DO K=1,SIZE(ED%Output(1)%BladeRootMotion) - ED%Output(1)%BladeRootMotion(K)%RemapFlag = .FALSE. + ED%y%TowerLn2Mesh%RemapFlag = .FALSE. + DO K=1,SIZE(ED%y%BladeRootMotion) + ED%y%BladeRootMotion(K)%RemapFlag = .FALSE. END DO if (allocated(ED%Input(1)%BladePtLoads)) then DO K=1,SIZE(ED%Input(1)%BladePtLoads) ED%Input( 1)%BladePtLoads(K)%RemapFlag = .FALSE. - ED%Output(1)%BladeLn2Mesh(K)%RemapFlag = .FALSE. + ED%y%BladeLn2Mesh(K)%RemapFlag = .FALSE. END DO end if - ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. - ED%Output(1)%NacelleMotion%RemapFlag = .FALSE. - ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. - ED%Output(1)%HubPtMotion%RemapFlag = .FALSE. + ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. + ED%y%NacelleMotion%RemapFlag = .FALSE. + ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. + ED%y%HubPtMotion%RemapFlag = .FALSE. ! BeamDyn meshes IF ( p_FAST%CompElast == Module_BD ) THEN @@ -3823,40 +3936,46 @@ END SUBROUTINE ResetRemapFlags SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + TYPE(ElastoDyn_Data),TARGET,INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER :: K, i ! loop counters - INTEGER :: NumBl ! number of blades - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InitModuleMappings' + INTEGER :: K, i ! loop counters + INTEGER :: NumBl ! number of blades + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'InitModuleMappings' + + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: PlatformLoads !............................................................................................................................ ErrStat = ErrID_None ErrMsg = "" - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) + + NumBl = SIZE(ED%y%BladeRootMotion,1) + PlatformMotion => ED%y%PlatformPtMesh + PlatformLoads => ED%Input(1)%PlatformPtMesh !............................................................................................................................ ! Create the data structures and mappings in MeshMapType @@ -3876,7 +3995,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeRootMotion(K), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeRootMotion(K), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_BD_BladeRootMotion('//TRIM(Num2LStr(K))//')' ) CALL MeshMapCreate( BD%y(k)%ReactionForce, ED%Input(1)%HubPtLoad, MeshMapData%BD_P_2_ED_P(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BD_2_ED_ReactionLoad('//TRIM(Num2LStr(K))//')' ) @@ -3890,20 +4009,20 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%HubPtMotion, BD%Input(1,k)%HubMotion, MeshMapData%ED_P_2_BD_P_Hub(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%HubPtMotion, BD%Input(1,k)%HubMotion, MeshMapData%ED_P_2_BD_P_Hub(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_BD_HubMotion('//TRIM(Num2LStr(K))//')' ) END DO - + END IF - !------------------------- ! ElastoDyn <-> ServoDyn !------------------------- + IF ( SrvD%Input(1)%NTMD%Mesh%Committed ) THEN ! ED-SrvD - CALL MeshMapCreate( ED%Output(1)%NacelleMotion, SrvD%Input(1)%NTMD%Mesh, MeshMapData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%NacelleMotion, SrvD%Input(1)%NTMD%Mesh, MeshMapData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_SrvD_NacelleMotion' ) CALL MeshMapCreate( SrvD%y%NTMD%Mesh, ED%Input(1)%NacelleLoads, MeshMapData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SrvD_2_ED_NacelleLoads' ) @@ -3912,13 +4031,12 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M IF ( SrvD%Input(1)%TTMD%Mesh%Committed ) THEN ! ED-SrvD - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, SrvD%Input(1)%TTMD%Mesh, MeshMapData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, SrvD%Input(1)%TTMD%Mesh, MeshMapData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_SrvD_TowerMotion' ) CALL MeshMapCreate( SrvD%y%TTMD%Mesh, ED%Input(1)%TowerPtLoads, MeshMapData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SrvD_2_ED_TowerLoad' ) - END IF - + END IF !------------------------- ! ElastoDyn <-> AeroDyn14 @@ -3942,7 +4060,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Tower mesh: IF ( AD14%Input(1)%Twr_InputMarkers%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) CALL MeshMapCreate( AD14%y%Twr_OutputLoads, ED%Input(1)%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TowerLoad' ) @@ -3952,8 +4070,6 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ELSEIF ( p_FAST%CompAero == Module_AD ) THEN ! ED-AD and/or BD-AD - NumBl = SIZE(AD%Input(1)%BladeRootMotion) - ! allocate per-blade space for mapping to structural module ! Blade root meshes @@ -3972,25 +4088,26 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF + !------------------------- ! ElastoDyn <-> AeroDyn !------------------------- ! blade root meshes DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeRootMotion(K), AD%Input(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeRootMotion(K), AD%Input(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_RootMotion('//TRIM(Num2LStr(K))//')' ) END DO ! Hub point mesh - CALL MeshMapCreate( ED%Output(1)%HubPtMotion, AD%Input(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%HubPtMotion, AD%Input(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_HubMotion' ) ! Tower mesh: IF ( AD%Input(1)%TowerMotion%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, AD%Input(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD%Input(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) IF ( AD%y%TowerLoad%Committed ) THEN @@ -4004,7 +4121,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Blade meshes: DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeLn2Mesh(K), AD%Input(1)%BladeMotion(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeLn2Mesh(K), AD%Input(1)%BladeMotion(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_BladeMotion('//TRIM(Num2LStr(K))//')' ) CALL MeshMapCreate( AD%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%AD_L_2_BDED_B(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_BladeLoad('//TRIM(Num2LStr(K))//')' ) @@ -4027,8 +4144,8 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! BeamDyn <-> BeamDyn !------------------------- - if (.not. p_FAST%BD_OutputSibling) then - + if (.not. p_FAST%BD_OutputSibling) then + ! Blade meshes for load transfer: (allocate meshes at BD input locations for motions transferred from BD output locations) ALLOCATE( MeshMapData%BD_L_2_BD_L(NumBl), MeshMapData%y_BD_BldMotion_4Loads(NumBl), STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN @@ -4072,42 +4189,41 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! HydroDyn <-> ElastoDyn -!------------------------- - IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn - - ! we're just going to assume ED%Input(1)%PlatformPtMesh is committed +!------------------------- + IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn ! (offshore floating) + + ! we're just going to assume PlatformLoads and PlatformMotion are committed IF ( HD%y%AllHdroOrigin%Committed ) THEN ! meshes for floating ! HydroDyn WAMIT point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( HD%y%AllHdroOrigin, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) - END IF + CALL MeshMapCreate( HD%y%AllHdroOrigin, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_W_P' ) + END IF ! ElastoDyn point mesh HydroDyn Morison point mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) - IF ( HD%Input(1)%Morison%LumpedMesh%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_P' ) + IF ( HD%Input(1)%Morison%LumpedMesh%Committed ) THEN + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_M_P' ) END IF - ! ElastoDyn point mesh to HydroDyn Morison line mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) + ! ElastoDyn point mesh to HydroDyn Morison line mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) IF ( HD%Input(1)%Morison%DistribMesh%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_L' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_M_L' ) END IF ELSE ! these get mapped to ElastoDyn AND SubDyn (in ED_SD_HD coupling) ! offshore fixed - ! HydroDyn WAMIT mesh to ElastoDyn point mesh + ! HydroDyn WAMIT mesh to ElastoDyn point mesh IF ( HD%y%Mesh%Committed ) THEN - ! HydroDyn WAMIT point mesh to ElastoDyn point mesh ! meshes for fixed-bottom - CALL MeshMapCreate( HD%y%Mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) + CALL MeshMapCreate( HD%y%Mesh, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_W_P' ) END IF !------------------------- @@ -4150,10 +4266,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! NOTE: the MeshMapCreate routine returns fatal errors if either mesh is not committed ! SubDyn transition piece point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( SD%y%Y1mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SD_TP' ) + CALL MeshMapCreate( SD%y%Y1mesh, PlatformLoads, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) !------------------------- ! ElastoDyn <-> ExtPtfm @@ -4163,10 +4279,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! NOTE: the MeshMapCreate routine returns fatal errors if either mesh is not committed ! ExtPtfm PtfmMesh point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( ExtPtfm%y%PtfmMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SD_TP' ) + CALL MeshMapCreate( ExtPtfm%y%PtfmMesh, PlatformLoads, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) END IF ! SubDyn-ElastoDyn @@ -4177,10 +4293,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! MAP point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MAPp%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( MAPp%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN !------------------------- @@ -4188,10 +4304,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! MoorDyn point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( MD%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !------------------------- @@ -4199,10 +4315,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! FEAMooring point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( FEAM%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN !------------------------- @@ -4210,10 +4326,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! OrcaFlex point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( Orca%y%PtfmMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( Orca%y%PtfmMesh, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) END IF ! MAP-ElastoDyn ; FEAM-ElastoDyn; Orca-ElastoDyn @@ -4262,14 +4378,14 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! Initialize the Jacobian structures: !............................................................................................................................ - !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN ! p_FAST%CompSub == Module_SD .AND. p_FAST%CompHydro == Module_HD + !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .or. p_FAST%CompMooring == Module_Orca) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN CALL Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED%Input(1)%PlatformPtMesh, SD%Input(1)%TPMesh, SD%Input(1)%LMesh, & HD%Input(1)%Morison%LumpedMesh, HD%Input(1)%Morison%DistribMesh, HD%Input(1)%Mesh, & ED%Input(1)%HubPtLoad, BD%Input(1,:), Orca%Input(1)%PtfmMesh, ExtPtfm%Input(1)%PtfmMesh, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN - CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for ED-HD coupling', ErrStat2, ErrMsg2 ) + CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for Ptfm-HD coupling', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4286,7 +4402,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................ - ! initialize the temporary input meshes (for input-output solves): + ! initialize the temporary input meshes (for input-output solves in Solve Option 1): ! (note that we do this after ResetRemapFlags() so that the copies have remap=false) !............................................................................................................................ IF ( p_FAST%CompHydro == Module_HD .OR. p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) & @@ -4307,7 +4423,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Temporary meshes for transfering inputs to ED and BD CALL MeshCopy ( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad_2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh' ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad_2' ) allocate( MeshMapData%u_BD_RootMotion( p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then @@ -4378,8 +4494,9 @@ END SUBROUTINE InitModuleMappings !> This subroutine solves the input-output relations for all of the modules. It is a subroutine because it gets done twice-- !! once at the start of the n_t_global loop and once in the j_pc loop, using different states. !! *** Note that modules that do not have direct feedthrough should be called first. *** -SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, p_FAST, m_FAST, & - ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, & + p_FAST, m_FAST, WriteThisStep, ED, BD, & + SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) INTEGER(IntKi) , intent(in ) :: n_t_global !< current time step (used only for SrvD hack) @@ -4388,6 +4505,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables (including external inputs) for the glue code + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data @@ -4453,30 +4571,31 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !! !! ## Algorithm: + !> Solve option 2 (modules without direct feedthrough): - CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0) + CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - -#ifdef OUTPUT_MASS_MATRIX -if (n_t_global == 0) then - UnMM = -1 - CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) - CALL OpenFOutFile( UnMM, TRIM(p_FAST%OutFileRoot)//'.EDMassMatrix', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL WrMatrix(ED%m%AugMat,UnMM, p_FAST%OutFmt) - CLOSE( UnMM ) -end if + +#ifdef OUTPUT_MASS_MATRIX + if (n_t_global == 0) then + UnMM = -1 + CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) + CALL OpenFOutFile( UnMM, TRIM(p_FAST%OutFileRoot)//'.EDMassMatrix', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL WrMatrix(ED%m%AugMat,UnMM, p_FAST%OutFmt) + CLOSE( UnMM ) + end if #endif - + !> transfer ED outputs to other modules used in option 1: - CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%Output(1), HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & + CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%y, HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & MAPp%Input(1), FEAM%Input(1), MD%Input(1), & Orca%Input(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !> Solve option 1 (rigorous solve on loads/accelerations) - CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4484,7 +4603,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, @@ -4494,7 +4613,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%Output(1), BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, @@ -4506,29 +4625,28 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%Output(1), ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(:), IfW%p, AD14%Input(1), AD%Input(1), AD%OtherSt(1), ED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN ! OpenFOAM is the driver and it sets these inputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** - CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2, SrvD%y ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF (p_FAST%CompElast == Module_BD .and. .NOT. BD_Solve_Option1) THEN ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(ED%Output(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF - - + !..................................................................... ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... @@ -4540,7 +4658,7 @@ END SUBROUTINE CalcOutputs_And_SolveForInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 1" solve for all inputs with direct links to HD, SD, ExtPtfm, MAP, OrcaFlex interface, and the ED !! platform reference point. Also in solve option 1 are the BD-ED blade root coupling. -SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) !............................................................................................................................... REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4567,6 +4685,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER :: i ! loop counter @@ -4626,7 +4745,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .OR. p_FAST%CompMooring == Module_Orca ) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN CALL FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & - , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%Output(1), ED%m & + , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%y, ED%m & , SD%Input(1), SD%p, SD%x( this_state), SD%xd( this_state), SD%z( this_state), SD%OtherSt( this_state), SD%y , SD%m & , ExtPtfm%Input(1),ExtPtfm%p,ExtPtfm%x( this_state),ExtPtfm%xd( this_state),ExtPtfm%z( this_state),ExtPtfm%OtherSt( this_state),ExtPtfm%y,ExtPtfm%m & , HD%Input(1), HD%p, HD%x( this_state), HD%xd( this_state), HD%z( this_state), HD%OtherSt( this_state), HD%y , HD%m & @@ -4637,17 +4756,17 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, , MD%Input(1), MD%y & , IceF%Input(1), IceF%y & , IceD%Input(1,:), IceD%y & ! bjj: I don't really want to make temp copies of input types. perhaps we should pass the whole Input() structure? (likewise for BD)... - , MeshMapData , ErrStat2, ErrMsg2 ) + , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN CALL ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & - , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%Output(1), ED%m & - , HD%Input(1), HD%p, HD%x(this_state), HD%xd(this_state), HD%z(this_state), HD%OtherSt(this_state), HD%y, HD%m & + , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m & + , HD%Input(1), HD%p, HD%x(this_state), HD%xd(this_state), HD%z(this_state), HD%OtherSt(this_state), HD%y, HD%m & , MAPp%Input(1), MAPp%y, FEAM%Input(1), FEAM%y, MD%Input(1), MD%y & - , MeshMapData , ErrStat2, ErrMsg2 ) + , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! HD, BD, and/or SD coupled to ElastoDyn @@ -4659,19 +4778,19 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompMooring == Module_MAP ) THEN ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL MAP_InputSolve( MAPp%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL MAP_InputSolve( MAPp%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL MD_InputSolve( MD%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL MD_InputSolve( MD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL FEAM_InputSolve( FEAM%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL FEAM_InputSolve( FEAM%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4717,7 +4836,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, END SUBROUTINE SolveOption1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to BeamDyn and AeroDyn -SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4737,8 +4856,8 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -4752,12 +4871,12 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A ErrStat = ErrID_None ErrMsg = "" - CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%Output(1), ED%m, ErrStat2, ErrMsg2 ) + CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(ED%Output(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF @@ -4765,7 +4884,7 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A END SUBROUTINE SolveOption2a_Inp2BD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn & InflowWind -SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4785,6 +4904,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 @@ -4799,40 +4919,39 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, ErrStat = ErrID_None ErrMsg = "" - + IF ( p_FAST%CompElast == Module_BD .AND. .NOT. BD_Solve_Option1 ) THEN DO k=1,p_FAST%nBeams CALL BD_CalcOutput( this_time, BD%Input(1,k), BD%p(k), BD%x(k,this_state), BD%xd(k,this_state),& - BD%z(k,this_state), BD%OtherSt(k,this_state), BD%y(k), BD%m(k), ErrStat2, ErrMsg2 ) + BD%z(k,this_state), BD%OtherSt(k,this_state), BD%y(k), BD%m(k), ErrStat2, ErrMsg2, .false. ) ! this WriteOutput will get overwritten in solve option 1 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO END IF - ! find the positions where we want inflow wind in AeroDyn (i.e., set all the motion inputs to AeroDyn) IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF ( p_FAST%CompAero == Module_AD ) THEN ! note that this uses BD outputs, which are from the previous step (and need to be initialized) - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%Output(1), BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF (p_FAST%CompInflow == Module_IfW) THEN ! must be done after ED_CalcOutput and before AD_CalcOutput and SrvD - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%Output(1), ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(:), IfW%p, AD14%Input(1), AD%Input(1), AD%OtherSt(1), ED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** - ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4840,8 +4959,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, END SUBROUTINE SolveOption2b_Inp2IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn and ServoDyn. -SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall) - LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) +SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4861,8 +4979,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -4878,7 +4996,7 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, IF (p_FAST%CompInflow == Module_IfW) THEN - + CALL InflowWind_CalcOutput( this_time, IfW%Input(1), IfW%p, IfW%x(this_state), IfW%xd(this_state), IfW%z(this_state), & IfW%OtherSt(this_state), IfW%y, IfW%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4886,6 +5004,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** + ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! CALL OpFM_SetWriteOutput(OpFM) END IF @@ -4905,15 +5025,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, IF ( p_FAST%CompServo == Module_SrvD ) THEN - !!!CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) - !!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! note that the inputs at step(n) for ServoDyn include the outputs from step(n-1) - IF ( firstCall ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) - ELSE - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2, SrvD%y ) ! note that this uses the outputs from the previous step, violating the framework for the Bladed DLL (if SrvD%y is used in another way, this will need to be changed) - END IF - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4921,7 +5034,7 @@ END SUBROUTINE SolveOption2c_Inp2AD_SrvD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 2" solve for all inputs without direct links to HD, SD, MAP, or the ED platform reference !! point. -SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall) +SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) !............................................................................................................................... LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) @@ -4943,13 +5056,12 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption2' + CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption2' !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> ++ Option 2: Solve for inputs based only on the current outputs. @@ -4963,18 +5075,17 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! SolveOption2* routines are being called in FAST_AdvanceStates, but the first time we call CalcOutputs_And_SolveForInputs, we haven't called the AdvanceStates routine IF (firstCall) THEN ! call ElastoDyn's CalcOutput & compute BD inputs from ED: - CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! compute AD position inputs; compute all of IfW inputs from ED/BD outputs: - CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! call IfW's CalcOutput; transfer wind-inflow inputs to AD; compute all of SrvD inputs: - CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, firstCall) + CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! ELSE ! these subroutines are called in the AdvanceStates routine before BD, IfW, AD, and SrvD states are updated. This gives a more accurate solution that would otherwise require a correction step. END IF - - + IF ( p_FAST%CompAero == Module_AD14 ) THEN CALL AD14_CalcOutput( this_time, AD14%Input(1), AD14%p, AD14%x(this_state), AD14%xd(this_state), AD14%z(this_state), & @@ -4984,13 +5095,13 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ELSE IF ( p_FAST%CompAero == Module_AD ) THEN CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & - AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2 ) + AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + IF ( p_FAST%CompServo == Module_SrvD ) THEN - + CALL SrvD_CalcOutput( this_time, SrvD%Input(1), SrvD%p, SrvD%x(this_state), SrvD%xd(this_state), SrvD%z(this_state), & SrvD%OtherSt(this_state), SrvD%y, SrvD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5002,7 +5113,7 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** ! note that I'm setting these inputs AFTER the call to ServoDyn so OpenFOAM gets all the inputs updated at the same step - CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL OpFM_SetWriteOutput(OpFM) @@ -5010,23 +5121,21 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, !bjj: note ED%Input(1) may be a sibling mesh of output, but ED%u is not (routine may update something that needs to be shared between siblings) - CALL ED_InputSolve( p_FAST, ED%Input(1), ED%Output(1), AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL ED_InputSolve( p_FAST, ED%Input(1), ED%y, AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module -SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data @@ -5050,6 +5159,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step (for optimizations with SolveOption2)? ! local variables INTEGER(IntKi) :: i, k ! loop counters @@ -5057,7 +5167,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED REAL(DbKi) :: t_module ! Current simulation time for module REAL(DbKi) :: t_global_next ! Simulation time for computing outputs INTEGER(IntKi) :: j_ss ! substep loop counter - INTEGER(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + INTEGER(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceStates' @@ -5091,12 +5201,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL ED_UpdateStates( t_module, n_t_module, ED%Input, ED%InputTimes, ED%p, ED%x(STATE_PRED), ED%xd(STATE_PRED), & ED%z(STATE_PRED), ED%OtherSt(STATE_PRED), ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + IF (ErrStat >= AbortErrLev) RETURN END DO !j_ss + - ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. - ! AD15/DBEMT also doesn't like extrapolated motions, so we will calculate them from ED/BD instead of doing a correction step. - CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. + ! (Also calls ED_CalcOutput here so that we can use it for AeroDyn optimization, too): + CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN @@ -5122,12 +5233,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END DO !j_ss END DO !nBeams + IF (ErrStat >= AbortErrLev) RETURN END IF !CompElast - + ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated structural outputs here - CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5154,7 +5266,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated inflow outputs here - CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, .false.) + CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! AeroDyn: get predicted states @@ -5185,7 +5297,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CopyOtherState( AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + DO j_ss = 1, p_FAST%n_substeps( MODULE_AD ) n_t_module = n_t_global*p_FAST%n_substeps( MODULE_AD ) + j_ss - 1 t_module = n_t_module*p_FAST%dt_module( MODULE_AD ) + t_initial @@ -5193,10 +5305,14 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL AD_UpdateStates( t_module, n_t_module, AD%Input, AD%InputTimes, AD%p, AD%x(STATE_PRED), & AD%xd(STATE_PRED), AD%z(STATE_PRED), AD%OtherSt(STATE_PRED), AD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! We don't want to extrapolate any values for the WakeLocations (those are exactly calculated) + if (allocated(AD%OtherSt(STATE_PRED)%WakeLocationPoints)) then + AD%OtherSt(STATE_CURR)%WakeLocationPoints = AD%OtherSt(STATE_PRED)%WakeLocationPoints + endif END DO !j_ss END IF - + ! ServoDyn: get predicted states IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5215,6 +5331,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input, SrvD%InputTimes, SrvD%p, SrvD%x(STATE_PRED), SrvD%xd(STATE_PRED), & SrvD%z(STATE_PRED), SrvD%OtherSt(STATE_PRED), SrvD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return END DO !j_ss END IF @@ -5411,12 +5528,11 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END SUBROUTINE FAST_AdvanceStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine extrapolates inputs to modules to give predicted values at t+dt. -SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data @@ -5450,9 +5566,9 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Step 1.a: Extrapolate Inputs (gives predicted values at t+dt) ! - ! a) Extrapolate inputs (and outputs -- bjj: output extrapolation not necessary, yet) + ! a) Extrapolate inputs ! to t + dt (i.e., t_global_next); will only be used by modules with an implicit dependence on input data. - ! b) Shift "window" of the ModName_Input and ModName_Output + ! b) Shift "window" of the ModName%Input !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ErrStat = ErrID_None @@ -5462,23 +5578,15 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL ED_Input_ExtrapInterp(ED%Input, ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_Output_ExtrapInterp(ED%Output, ED%InputTimes, ED%y, t_global_next, ErrStat2, ErrMsg2) !this extrapolated value is used in the ED-HD coupling - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - DO j = p_FAST%InterpOrder, 1, -1 CALL ED_CopyInput (ED%Input(j), ED%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ED%InputTimes(j+1) = ED%InputTimes(j) !ED_OutputTimes(j+1) = ED_OutputTimes(j) END DO CALL ED_CopyInput (ED%u, ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ED%InputTimes(1) = t_global_next !ED_OutputTimes(1) = t_global_next @@ -5505,8 +5613,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, END DO ! k=p_FAST%nBeams - END IF ! BeamDyn - + END IF ! BeamDyn ! AeroDyn v14 IF ( p_FAST%CompAero == Module_AD14 ) THEN @@ -5514,11 +5621,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL AD14_Input_ExtrapInterp(AD14%Input, AD14%InputTimes, AD14%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL AD14_Output_ExtrapInterp(AD14_Output, AD14_OutputTimes, AD14%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of AD14%Input and AD14_Output + ! Shift "window" of AD14%Input DO j = p_FAST%InterpOrder, 1, -1 CALL AD14_CopyInput (AD14%Input(j), AD14%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5556,25 +5659,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL InflowWind_Input_ExtrapInterp(IfW%Input, IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_Output_ExtrapInterp(IfW_Output, IfW_OutputTimes, IfW%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of IfW%Input and IfW_Output + ! Shift "window" of IfW%Input DO j = p_FAST%InterpOrder, 1, -1 CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_CopyOutput(IfW_Output(j), IfW_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IfW%InputTimes(j+1) = IfW%InputTimes(j) - !IfW_OutputTimes(j+1) = IfW_OutputTimes(j) END DO CALL InflowWind_CopyInput (IfW%u, IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_CopyOutput(IfW%y, IfW_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IfW%InputTimes(1) = t_global_next - !IfW_OutputTimes(1) = t_global_next END IF ! CompInflow @@ -5584,26 +5679,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL SrvD_Input_ExtrapInterp(SrvD%Input, SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL SrvD_Output_ExtrapInterp(SrvD_Output, SrvD_OutputTimes, SrvD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of SrvD%Input and SrvD_Output + ! Shift "window" of SrvD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SrvD_CopyOutput(SrvD_Output(j), SrvD_Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) SrvD%InputTimes(j+1) = SrvD%InputTimes(j) - !SrvD_OutputTimes(j+1) = SrvD_OutputTimes(j) END DO CALL SrvD_CopyInput (SrvD%u, SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SrvD_CopyOutput(SrvD%y, SrvD_Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) SrvD%InputTimes(1) = t_global_next - !SrvD_OutputTimes(1) = t_global_next END IF ! ServoDyn @@ -5613,25 +5700,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL HydroDyn_Input_ExtrapInterp(HD%Input, HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_Output_ExtrapInterp(HD_Output, HD_OutputTimes, HD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of HD%Input and HD_Output + ! Shift "window" of HD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL HydroDyn_CopyInput (HD%Input(j), HD%Input(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_CopyOutput(HD_Output(j), HD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) HD%InputTimes(j+1) = HD%InputTimes(j) - !HD_OutputTimes(j+1)= HD_OutputTimes(j) END DO CALL HydroDyn_CopyInput (HD%u, HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_CopyOutput(HD%y, HD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) HD%InputTimes(1) = t_global_next - !HD_OutputTimes(1) = t_global_next END IF ! HydroDyn @@ -5641,55 +5721,38 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL SD_Input_ExtrapInterp(SD%Input, SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL SD_Output_ExtrapInterp(SD_Output, SD_OutputTimes, SD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of SD%Input and SD_Output + ! Shift "window" of SD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL SD_CopyInput (SD%Input(j), SD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SD_CopyOutput(SD_Output(j), SD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) SD%InputTimes(j+1) = SD%InputTimes(j) - !SD_OutputTimes(j+1) = SD_OutputTimes(j) END DO CALL SD_CopyInput (SD%u, SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SD_CopyOutput(SD%y, SD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) SD%InputTimes(1) = t_global_next - !SD_OutputTimes(1) = t_global_next ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_Output_ExtrapInterp(ExtPtfm_Output, ExtPtfm_OutputTimes, ExtPtfm%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of ExtPtfm%Input and ExtPtfm_Output + ! Shift "window" of ExtPtfm%Input DO j = p_FAST%InterpOrder, 1, -1 CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_CopyOutput(ExtPtfm_Output(j), ExtPtfm_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ExtPtfm%InputTimes(j+1) = ExtPtfm%InputTimes(j) - !ExtPtfm_OutputTimes(j+1) = ExtPtfm_OutputTimes(j) END DO CALL ExtPtfm_CopyInput (ExtPtfm%u, ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_CopyOutput(ExtPtfm%y, ExtPtfm_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ExtPtfm%InputTimes(1) = t_global_next - !ExtPtfm_OutputTimes(1) = t_global_next END IF ! SubDyn/ExtPtfm_MCKF - ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN @@ -5697,25 +5760,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL MAP_Input_ExtrapInterp(MAPp%Input, MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_Output_ExtrapInterp(MAP_Output, MAP_OutputTimes, MAPp%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of MAPp%Input and MAP_Output + ! Shift "window" of MAPp%Input DO j = p_FAST%InterpOrder, 1, -1 CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_CopyOutput(MAP_Output(j), MAP_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MAPp%InputTimes(j+1) = MAPp%InputTimes(j) - !MAP_OutputTimes(j+1) = MAP_OutputTimes(j) END DO CALL MAP_CopyInput (MAPp%u, MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_CopyOutput(MAPp%y, MAP_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MAPp%InputTimes(1) = t_global_next - !MAP_OutputTimes(1) = t_global_next ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN @@ -5723,25 +5778,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL MD_Input_ExtrapInterp(MD%Input, MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_Output_ExtrapInterp(MD_Output, MD_OutputTimes, MD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of MD%Input and MD_Output + ! Shift "window" of MD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL MD_CopyInput (MD%Input(j), MD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_CopyOutput(MD_Output(j), MD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MD%InputTimes( j+1) = MD%InputTimes( j) - !MD_OutputTimes(j+1) = MD_OutputTimes(j) END DO CALL MD_CopyInput (MD%u, MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_CopyOutput(MD%y, MD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MD%InputTimes(1) = t_global_next - !MD_OutputTimes(1) = t_global_next ! FEAM ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN @@ -5749,25 +5796,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL FEAM_Input_ExtrapInterp(FEAM%Input, FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_Output_ExtrapInterp(FEAM_Output, FEAM_OutputTimes, FEAM%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of FEAM%Input and FEAM_Output + ! Shift "window" of FEAM%Input DO j = p_FAST%InterpOrder, 1, -1 CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_CopyOutput(FEAM_Output(j), FEAM_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) FEAM%InputTimes( j+1) = FEAM%InputTimes( j) - !FEAM_OutputTimes(j+1) = FEAM_OutputTimes(j) END DO CALL FEAM_CopyInput (FEAM%u, FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_CopyOutput(FEAM%y, FEAM_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) FEAM%InputTimes(1) = t_global_next - !FEAM_OutputTimes(1) = t_global_next ! OrcaFlex ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN @@ -5797,26 +5836,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL IceFloe_Input_ExtrapInterp(IceF%Input, IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL IceFloe_Output_ExtrapInterp(IceF_Output, IceF_OutputTimes, IceF%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of IceF%Input and IceF_Output + ! Shift "window" of IceF%Input DO j = p_FAST%InterpOrder, 1, -1 CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceFloe_CopyOutput(IceF_Output(j), IceF_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceF%InputTimes(j+1) = IceF%InputTimes(j) - !IceF_OutputTimes(j+1) = IceF_OutputTimes(j) END DO CALL IceFloe_CopyInput (IceF%u, IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceFloe_CopyOutput(IceF%y, IceF_Output(1), MESH_UPDATECOPY, Errstat, ErrMsg) IceF%InputTimes(1) = t_global_next - !IceF_OutputTimes(1) = t_global_next ! IceDyn ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN @@ -5825,26 +5856,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL IceD_Input_ExtrapInterp(IceD%Input(:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL IceD_Output_ExtrapInterp(IceD%Output(:,i), IceD%OutputTimes(:,i), IceD%y(i), t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of IceD%Input and IceD%Output + ! Shift "window" of IceD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input(j+1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceD_CopyOutput(IceD%Output(j,i), IceD%Output(j+1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceD%InputTimes(j+1,i) = IceD%InputTimes(j,i) - !IceD%OutputTimes(j+1,i) = IceD%OutputTimes(j,i) END DO CALL IceD_CopyInput (IceD%u(i), IceD%Input(1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceD_CopyOutput(IceD%y(i), IceD%Output(1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceD%InputTimes(1,i) = t_global_next - !IceD%OutputTimes(1,i) = t_global_next END DO ! numIceLegs diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 338ada5769..1ba775af77 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -23,7 +23,6 @@ MODULE FAST_Subs USE FAST_Solver USE FAST_Linear - USE VersionInfo IMPLICIT NONE @@ -107,57 +106,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! local variables CHARACTER(1024) :: InputFile !< A CHARACTER string containing the name of the primary FAST input file + TYPE(FAST_InitData) :: Init !< Initialization data for all modules - TYPE(ED_InitInputType) :: InitInData_ED ! Initialization input data - TYPE(ED_InitOutputType) :: InitOutData_ED ! Initialization output data - - TYPE(BD_InitInputType) :: InitInData_BD ! Initialization input data - TYPE(BD_InitOutputType), ALLOCATABLE :: InitOutData_BD(:) ! Initialization output data - - TYPE(SrvD_InitInputType) :: InitInData_SrvD ! Initialization input data - TYPE(SrvD_InitOutputType) :: InitOutData_SrvD ! Initialization output data - - TYPE(AD14_InitInputType) :: InitInData_AD14 ! Initialization input data - TYPE(AD14_InitOutputType) :: InitOutData_AD14 ! Initialization output data - - TYPE(AD_InitInputType) :: InitInData_AD ! Initialization input data - TYPE(AD_InitOutputType) :: InitOutData_AD ! Initialization output data - - TYPE(InflowWind_InitInputType) :: InitInData_IfW ! Initialization input data - TYPE(InflowWind_InitOutputType) :: InitOutData_IfW ! Initialization output data - - TYPE(OpFM_InitInputType) :: InitInData_OpFM ! Initialization input data - TYPE(OpFM_InitOutputType) :: InitOutData_OpFM ! Initialization output data - - TYPE(SC_InitInputType) :: InitInData_SC ! Initialization input data - TYPE(SC_InitOutputType) :: InitOutData_SC ! Initialization output data - - TYPE(HydroDyn_InitInputType) :: InitInData_HD ! Initialization input data - TYPE(HydroDyn_InitOutputType) :: InitOutData_HD ! Initialization output data - - TYPE(SD_InitInputType) :: InitInData_SD ! Initialization input data - TYPE(SD_InitOutputType) :: InitOutData_SD ! Initialization output data - - TYPE(ExtPtfm_InitInputType) :: InitInData_ExtPtfm ! Initialization input data - TYPE(ExtPtfm_InitOutputType) :: InitOutData_ExtPtfm ! Initialization output data - - TYPE(MAP_InitInputType) :: InitInData_MAP ! Initialization input data - TYPE(MAP_InitOutputType) :: InitOutData_MAP ! Initialization output data - - TYPE(FEAM_InitInputType) :: InitInData_FEAM ! Initialization input data - TYPE(FEAM_InitOutputType) :: InitOutData_FEAM ! Initialization output data - - TYPE(MD_InitInputType) :: InitInData_MD ! Initialization input data - TYPE(MD_InitOutputType) :: InitOutData_MD ! Initialization output data - - TYPE(Orca_InitInputType) :: InitInData_Orca ! Initialization input data - TYPE(Orca_InitOutputType) :: InitOutData_Orca ! Initialization output data - - TYPE(IceFloe_InitInputType) :: InitInData_IceF ! Initialization input data - TYPE(IceFloe_InitOutputType) :: InitOutData_IceF ! Initialization output data - - TYPE(IceD_InitInputType) :: InitInData_IceD ! Initialization input data - TYPE(IceD_InitOutputType) :: InitOutData_IceD ! Initialization output data (each instance will have the same output channels) REAL(ReKi) :: AirDens ! air density for initialization/normalization of OpenFOAM data REAL(DbKi) :: dt_IceD ! tmp dt variable to ensure IceDyn doesn't specify different dt values for different legs (IceDyn instances) @@ -182,6 +132,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%UnGra = -1 ! set the binary graphics output file unit to -1 to indicate it's not open p_FAST%WrVTK = VTK_Unknown ! set this so that we can potentially output VTK information on initialization error + p_FAST%VTK_tWidth = 1 ! initialize in case of error before reading the full file + p_FAST%n_VTKTime = 1 ! initialize in case of error before reading the full file y_FAST%VTK_LastWaveIndx = 1 ! Start looking for wave data at the first index y_FAST%VTK_count = 0 ! first VTK file has 0 as output y_FAST%n_Out = 0 ! set the number of ouptut channels to 0 to indicate there's nothing to write to the binary file @@ -197,7 +149,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, m_FAST%calcJacobian = .TRUE. ! we need to calculate the Jacobian m_FAST%NextJacCalcTime = m_FAST%t_global ! We want to calculate the Jacobian on the first step p_FAST%TDesc = '' +! p_FAST%CheckHSSBrTrqC = .false. + y_FAST%Lin%WindSpeed = 0.0_ReKi + if (present(ExternInitData)) then CallStart = .not. ExternInitData%FarmIntegration ! .and. ExternInitData%TurbineID == 1 if (ExternInitData%TurbineID > 0) p_FAST%TDesc = 'T'//trim(num2lstr(ExternInitData%TurbineID)) @@ -235,14 +190,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%TurbinePos = ExternInitData%TurbinePos if (ExternInitData%FarmIntegration) then ! we're integrating with FAST.Farm - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) else - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) end if else p_FAST%TurbinePos = 0.0_ReKi - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) + 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 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -260,26 +215,26 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize ElastoDyn (must be done first) ! ........................ - ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ), ED%Output( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input, ED%Output, and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF - InitInData_ED%Linearize = p_FAST%Linearize - InitInData_ED%InputFile = p_FAST%EDFile + Init%InData_ED%Linearize = p_FAST%Linearize + Init%InData_ED%InputFile = p_FAST%EDFile IF ( p_FAST%CompAero == Module_AD14 ) THEN - InitInData_ED%ADInputFile = p_FAST%AeroFile + Init%InData_ED%ADInputFile = p_FAST%AeroFile ELSE - InitInData_ED%ADInputFile = "" + Init%InData_ED%ADInputFile = "" END IF - InitInData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) - InitInData_ED%CompElast = p_FAST%CompElast == Module_ED + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) + Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - CALL ED_Init( InitInData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, p_FAST%dt_module( MODULE_ED ), InitOutData_ED, ErrStat2, ErrMsg2 ) + CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_ED) = .TRUE. @@ -298,15 +253,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_ED%LinNames_y)) call move_alloc(InitOutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) - if (allocated(InitOutData_ED%LinNames_x)) call move_alloc(InitOutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) - if (allocated(InitOutData_ED%LinNames_u)) call move_alloc(InitOutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) - if (allocated(InitOutData_ED%RotFrame_y)) call move_alloc(InitOutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) - if (allocated(InitOutData_ED%RotFrame_x)) call move_alloc(InitOutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) - if (allocated(InitOutData_ED%RotFrame_u)) call move_alloc(InitOutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) - if (allocated(InitOutData_ED%IsLoad_u )) call move_alloc(InitOutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) + if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) + if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) + if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(InitOutData_ED%WriteOutputHdr) + if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -314,11 +270,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + if (p_FAST%CalcSteady) then + if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then + p_FAST%TrimCase = TrimCase_none + p_FAST%NLinTimes = 1 + p_FAST%LinInterpOrder = 0 ! constant values + elseif ( Init%OutData_ED%isFixed_GenDOF ) then + p_FAST%TrimCase = TrimCase_none + end if + end if + + ! ........................ ! initialize BeamDyn ! ........................ IF ( p_FAST%CompElast == Module_BD ) THEN - p_FAST%nBeams = InitOutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades ELSE p_FAST%nBeams = 0 END IF @@ -338,7 +305,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, BD%u( p_FAST%nBeams ), & BD%y( p_FAST%nBeams ), & BD%m( p_FAST%nBeams ), & - InitOutData_BD( p_FAST%nBeams ), & + Init%OutData_BD(p_FAST%nBeams ), & STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating BeamDyn state, input, and output data.",ErrStat,ErrMsg,RoutineName) @@ -348,16 +315,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (p_FAST%CompElast == Module_BD) THEN - InitInData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. - InitInData_BD%Linearize = p_FAST%Linearize - InitInData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -InitOutData_ED%Gravity /) ! "Gravitational acceleration" m/s^2 + Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -Init%OutData_ED%Gravity /) ! "Gravitational acceleration" m/s^2 ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module( MODULE_BD ) - InitInData_BD%HubPos = ED%Output(1)%HubPtMotion%Position(:,1) - InitInData_BD%HubRot = ED%Output(1)%HubPtMotion%RefOrientation(:,:,1) + Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) p_FAST%BD_OutputSibling = .true. @@ -369,21 +336,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if DO k=1,p_FAST%nBeams - InitInData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) + Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) - InitInData_BD%InputFile = p_FAST%BDBldFile(k) + Init%InData_BD%InputFile = p_FAST%BDBldFile(k) - InitInData_BD%GlbPos = ED%Output(1)%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" - InitInData_BD%GlbRot = ED%Output(1)%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + Init%InData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" + Init%InData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" - InitInData_BD%RootDisp = ED%Output(1)%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" - InitInData_BD%RootOri = ED%Output(1)%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" - InitInData_BD%RootVel(1:3) = ED%Output(1)%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - InitInData_BD%RootVel(4:6) = ED%Output(1)%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - CALL BD_Init( InitInData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & - BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, InitOutData_BD(k), ErrStat2, ErrMsg2 ) + CALL BD_Init( Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, Init%OutData_BD(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n BD modules with n timesteps. @@ -396,26 +363,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( .NOT. EqualRealNos( p_FAST%dt_module( MODULE_BD ),dt_BD )) THEN CALL SetErrStat(ErrID_Fatal,"All instances of BeamDyn (one per blade) must have the same time step.",ErrStat,ErrMsg,RoutineName) END IF - - ! BeamDyn shouldn't be run in static mode when coupled with FAST - if (BD%p(k)%analysis_type == BD_STATIC_ANALYSIS) then ! static - CALL SetErrStat(ErrID_Fatal,"BeamDyn cannot perform static analysis when coupled with FAST.",ErrStat,ErrMsg,RoutineName) - end if ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings: if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors - if (allocated(InitOutData_BD(k)%LinNames_y)) call move_alloc(InitOutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) - if (allocated(InitOutData_BD(k)%LinNames_x)) call move_alloc(InitOutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) - if (allocated(InitOutData_BD(k)%LinNames_u)) call move_alloc(InitOutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) - if (allocated(InitOutData_BD(k)%RotFrame_y)) call move_alloc(InitOutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) - if (allocated(InitOutData_BD(k)%RotFrame_x)) call move_alloc(InitOutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) - if (allocated(InitOutData_BD(k)%RotFrame_u)) call move_alloc(InitOutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) - if (allocated(InitOutData_BD(k)%IsLoad_u )) call move_alloc(InitOutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) + if (allocated(Init%OutData_BD(k)%LinNames_y)) call move_alloc(Init%OutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) + if (allocated(Init%OutData_BD(k)%LinNames_x)) call move_alloc(Init%OutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) + if (allocated(Init%OutData_BD(k)%LinNames_u)) call move_alloc(Init%OutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) + if (allocated(Init%OutData_BD(k)%RotFrame_y)) call move_alloc(Init%OutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) + if (allocated(Init%OutData_BD(k)%RotFrame_x)) call move_alloc(Init%OutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) + if (allocated(Init%OutData_BD(k)%RotFrame_u)) call move_alloc(Init%OutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) + if (allocated(Init%OutData_BD(k)%IsLoad_u )) call move_alloc(Init%OutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) + if (allocated(Init%OutData_BD(k)%DerivOrder_x )) call move_alloc(Init%OutData_BD(k)%DerivOrder_x , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) - if (allocated(InitOutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(InitOutData_BD(k)%WriteOutputHdr) + if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) END DO @@ -447,11 +410,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD_SetInitInput(InitInData_AD14, InitOutData_ED, ED%Output(1), p_FAST, ErrStat2, ErrMsg2) ! set the values in InitInData_AD14 + CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD14_Init( InitInData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & - AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), InitOutData_AD14, ErrStat2, ErrMsg2 ) + CALL AD14_Init( Init%InData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & + AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), Init%OutData_AD14, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_AD14) = .TRUE. @@ -464,7 +427,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 tower influence model "NEWTOWER" is invalid for models of floating offshore turbines.',ErrStat,ErrMsg,RoutineName) END IF - AirDens = InitOutData_AD14%AirDens + AirDens = Init%OutData_AD14%AirDens IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -475,30 +438,30 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! set initialization data for AD - CALL AllocAry( InitInData_AD%BladeRootPosition, 3, InitOutData_ED%NumBl, 'InitInData_AD%BladeRootPosition', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%BladeRootPosition, 3, Init%OutData_ED%NumBl, 'Init%InData_AD%BladeRootPosition', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( InitInData_AD%BladeRootOrientation,3, 3, InitOutData_ED%NumBl, 'InitInData_AD%BladeRootOrientation', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%BladeRootOrientation,3, 3, Init%OutData_ED%NumBl, 'Init%InData_AD%BladeRootOrientation', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - InitInData_AD%Gravity = InitOutData_ED%Gravity - InitInData_AD%Linearize = p_FAST%Linearize - InitInData_AD%InputFile = p_FAST%AeroFile - InitInData_AD%NumBlades = InitOutData_ED%NumBl - InitInData_AD%RootName = p_FAST%OutFileRoot - InitInData_AD%HubPosition = ED%Output(1)%HubPtMotion%Position(:,1) - InitInData_AD%HubOrientation = ED%Output(1)%HubPtMotion%RefOrientation(:,:,1) - - do k=1,InitOutData_ED%NumBl - InitInData_AD%BladeRootPosition(:,k) = ED%Output(1)%BladeRootMotion(k)%Position(:,1) - InitInData_AD%BladeRootOrientation(:,:,k) = ED%Output(1)%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_AD%Gravity = Init%OutData_ED%Gravity + Init%InData_AD%Linearize = p_FAST%Linearize + Init%InData_AD%InputFile = p_FAST%AeroFile + Init%InData_AD%NumBlades = Init%OutData_ED%NumBl + Init%InData_AD%RootName = p_FAST%OutFileRoot + Init%InData_AD%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_AD%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + + do k=1,Init%OutData_ED%NumBl + Init%InData_AD%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do - CALL AD_Init( InitInData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & - AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), InitOutData_AD, ErrStat2, ErrMsg2 ) + CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_AD) = .TRUE. @@ -509,15 +472,15 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_AD%LinNames_u)) call move_alloc(InitOutData_AD%LinNames_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(InitOutData_AD%LinNames_y)) call move_alloc(InitOutData_AD%LinNames_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(InitOutData_AD%LinNames_z)) call move_alloc(InitOutData_AD%LinNames_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_z ) - if (allocated(InitOutData_AD%RotFrame_u)) call move_alloc(InitOutData_AD%RotFrame_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_AD%RotFrame_y)) call move_alloc(InitOutData_AD%RotFrame_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_AD%RotFrame_z)) call move_alloc(InitOutData_AD%RotFrame_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_z ) - if (allocated(InitOutData_AD%IsLoad_u )) call move_alloc(InitOutData_AD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_AD%LinNames_u)) call move_alloc(Init%OutData_AD%LinNames_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_AD%LinNames_y)) call move_alloc(Init%OutData_AD%LinNames_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_AD%LinNames_z)) call move_alloc(Init%OutData_AD%LinNames_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_z ) + if (allocated(Init%OutData_AD%RotFrame_u)) call move_alloc(Init%OutData_AD%RotFrame_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_AD%RotFrame_y)) call move_alloc(Init%OutData_AD%RotFrame_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_AD%RotFrame_z)) call move_alloc(Init%OutData_AD%RotFrame_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_z ) + if (allocated(Init%OutData_AD%IsLoad_u )) call move_alloc(Init%OutData_AD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_AD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(InitOutData_AD%WriteOutputHdr) + if (allocated(Init%OutData_AD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -525,7 +488,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - AirDens = InitOutData_AD%AirDens + AirDens = Init%OutData_AD%AirDens ELSE AirDens = 0.0_ReKi @@ -544,46 +507,50 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompInflow == Module_IfW ) THEN - InitInData_IfW%Linearize = p_FAST%Linearize - InitInData_IfW%InputFileName = p_FAST%InflowFile - InitInData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) - InitInData_IfW%UseInputFile = .TRUE. + Init%InData_IfW%Linearize = p_FAST%Linearize + Init%InData_IfW%InputFileName = p_FAST%InflowFile + Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) + Init%InData_IfW%UseInputFile = .TRUE. - InitInData_IfW%NumWindPoints = 0 - IF ( p_FAST%CompServo == Module_SrvD ) InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + 1 + Init%InData_IfW%NumWindPoints = 0 + IF ( p_FAST%CompServo == Module_SrvD ) Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 IF ( p_FAST%CompAero == Module_AD14 ) THEN - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + InitOutData_ED%NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + Init%OutData_ED%NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + AD%Input(1)%TowerMotion%NNodes - DO k=1,InitOutData_ED%NumBl - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + AD%Input(1)%BladeMotion(k)%NNodes + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%TowerMotion%NNodes + DO k=1,Init%OutData_ED%NumBl + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%BladeMotion(k)%NNodes END DO + if (allocated(AD%OtherSt(STATE_CURR)%WakeLocationPoints)) then + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + size(AD%OtherSt(STATE_CURR)%WakeLocationPoints,DIM=2) + end if END IF ! lidar - InitInData_IfW%lidar%Tmax = p_FAST%TMax - InitInData_IfW%lidar%HubPosition = ED%Output(1)%HubPtMotion%Position(:,1) + Init%InData_IfW%lidar%Tmax = p_FAST%TMax + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + IF ( PRESENT(ExternInitData) ) THEN - InitInData_IfW%Use4Dext = ExternInitData%FarmIntegration + Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration - if (InitInData_IfW%Use4Dext) then - InitInData_IfW%FDext%n = ExternInitData%windGrid_n - InitInData_IfW%FDext%delta = ExternInitData%windGrid_delta - InitInData_IfW%FDext%pZero = ExternInitData%windGrid_pZero + if (Init%InData_IfW%Use4Dext) then + Init%InData_IfW%FDext%n = ExternInitData%windGrid_n + Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta + Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero end if ! bjj: these lidar inputs should come from an InflowWind input file; I'm hard coding them here for now - InitInData_IfW%lidar%SensorType = ExternInitData%SensorType - InitInData_IfW%lidar%LidRadialVel = ExternInitData%LidRadialVel - InitInData_IfW%lidar%RotorApexOffsetPos = 0.0 - InitInData_IfW%lidar%NumPulseGate = 0 + Init%InData_IfW%lidar%SensorType = ExternInitData%SensorType + Init%InData_IfW%lidar%LidRadialVel = ExternInitData%LidRadialVel + Init%InData_IfW%lidar%RotorApexOffsetPos = 0.0 + Init%InData_IfW%lidar%NumPulseGate = 0 ELSE - InitInData_IfW%lidar%SensorType = SensorType_None - InitInData_IfW%Use4Dext = .false. + Init%InData_IfW%lidar%SensorType = SensorType_None + Init%InData_IfW%Use4Dext = .false. END IF - CALL InflowWind_Init( InitInData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & - IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), InitOutData_IfW, ErrStat2, ErrMsg2 ) + CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IfW) = .TRUE. @@ -594,13 +561,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_IfW%LinNames_y)) call move_alloc(InitOutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) - if (allocated(InitOutData_IfW%LinNames_u)) call move_alloc(InitOutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) - if (allocated(InitOutData_IfW%RotFrame_y)) call move_alloc(InitOutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_IfW%RotFrame_u)) call move_alloc(InitOutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_IfW%IsLoad_u )) call move_alloc(InitOutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) - - if (allocated(InitOutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(InitOutData_IfW%WriteOutputHdr) + if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) + if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) + if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS end if IF (ErrStat >= AbortErrLev) THEN @@ -611,29 +579,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN IF ( PRESENT(ExternInitData) ) THEN - InitInData_OpFM%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_OpFM%NumCtrl2SC = ExternInitData%NumCtrl2SC - InitInData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade - InitInData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower + Init%InData_OpFM%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_OpFM%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower ELSE CALL SetErrStat( ErrID_Fatal, 'OpenFOAM integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) CALL Cleanup() RETURN END IF - InitInData_OpFM%BladeLength = InitOutData_ED%BladeLength - InitInData_OpFM%TowerHeight = InitOutData_ED%TowerHeight - InitInData_OpFM%TowerBaseHeight = InitOutData_ED%TowerBaseHeight - ALLOCATE(InitInData_OpFM%StructBldRNodes( SIZE(InitOutData_ED%BldRNodes)), STAT=ErrStat2) - InitInData_OpFM%StructBldRNodes(:) = InitOutData_ED%BldRNodes(:) - ALLOCATE(InitInData_OpFM%StructTwrHNodes( SIZE(InitOutData_ED%TwrHNodes)), STAT=ErrStat2) - InitInData_OpFM%StructTwrHNodes(:) = InitOutData_ED%TwrHNodes(:) + Init%InData_OpFM%BladeLength = Init%OutData_ED%BladeLength + Init%InData_OpFM%TowerHeight = Init%OutData_ED%TowerHeight + Init%InData_OpFM%TowerBaseHeight = Init%OutData_ED%TowerBaseHeight + ALLOCATE(Init%InData_OpFM%StructBldRNodes( SIZE(Init%OutData_ED%BldRNodes)), STAT=ErrStat2) + Init%InData_OpFM%StructBldRNodes(:) = Init%OutData_ED%BldRNodes(:) + ALLOCATE(Init%InData_OpFM%StructTwrHNodes( SIZE(Init%OutData_ED%TwrHNodes)), STAT=ErrStat2) + Init%InData_OpFM%StructTwrHNodes(:) = Init%OutData_ED%TwrHNodes(:) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating OpFM%InitInput.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF ! set up the data structures for integration with OpenFOAM - CALL Init_OpFM( InitInData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), InitOutData_AD, AD%y, ED%Output(1), OpFM, InitOutData_OpFM, ErrStat2, ErrMsg2 ) + CALL Init_OpFM( Init%InData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), Init%OutData_AD, AD%y, ED%y, OpFM, Init%OutData_OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -642,25 +610,25 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF !bjj: fix me!!! to do - InitOutData_IfW%WindFileInfo%MWS = 0.0_ReKi + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi ELSE - InitOutData_IfW%WindFileInfo%MWS = 0.0_ReKi + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi END IF ! CompInflow ! ........................ ! initialize SuperController ! ........................ IF ( PRESENT(ExternInitData) ) THEN - InitInData_SC%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SC%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_SC%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_SC%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE - InitInData_SC%NumSC2Ctrl = 0 - InitInData_SC%NumCtrl2SC = 0 + Init%InData_SC%NumSC2Ctrl = 0 + Init%InData_SC%NumCtrl2SC = 0 END IF ! set up the data structures for integration with supercontroller - CALL Init_SC( InitInData_SC, SC, ErrStat2, ErrMsg2 ) + CALL Init_SC( Init%InData_SC, SC, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -676,7 +644,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN IF (AD14%p%DynInfl) THEN - IF ( InitOutData_IfW%WindFileInfo%MWS < 8.0 ) THEN + IF ( Init%OutData_IfW%WindFileInfo%MWS < 8.0 ) THEN CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with wind speeds less than 8 m/s.',ErrStat,ErrMsg,RoutineName) !CALL SetErrStat(ErrID_Info,'Estimated average inflow wind speed is less than 8 m/s. Dynamic Inflow will be turned off.',ErrStat,ErrMess,RoutineName ) END IF @@ -695,35 +663,43 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - InitInData_SrvD%InputFile = p_FAST%ServoFile - InitInData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) - InitInData_SrvD%NumBl = InitOutData_ED%NumBl - InitInData_SrvD%gravity = InitOutData_ED%gravity - InitInData_SrvD%r_N_O_G = ED%Input(1)%NacelleLoads%Position(:,1) - InitInData_SrvD%r_TwrBase = InitOutData_ED%TwrBasePos - InitInData_SrvD%TMax = p_FAST%TMax - InitInData_SrvD%AirDens = AirDens - InitInData_SrvD%AvgWindSpeed = InitOutData_IfW%WindFileInfo%MWS - InitInData_SrvD%Linearize = p_FAST%Linearize + Init%InData_SrvD%InputFile = p_FAST%ServoFile + Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) + Init%InData_SrvD%NumBl = Init%OutData_ED%NumBl + Init%InData_SrvD%gravity = Init%OutData_ED%gravity + Init%InData_SrvD%r_N_O_G = ED%Input(1)%NacelleLoads%Position(:,1) + Init%InData_SrvD%r_TwrBase = Init%OutData_ED%TwrBasePos + Init%InData_SrvD%TMax = p_FAST%TMax + Init%InData_SrvD%AirDens = AirDens + Init%InData_SrvD%AvgWindSpeed = Init%OutData_IfW%WindFileInfo%MWS + Init%InData_SrvD%Linearize = p_FAST%Linearize + Init%InData_SrvD%TrimCase = p_FAST%TrimCase + Init%InData_SrvD%TrimGain = p_FAST%TrimGain + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed IF ( PRESENT(ExternInitData) ) THEN - InitInData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE - InitInData_SrvD%NumSC2Ctrl = 0 - InitInData_SrvD%NumCtrl2SC = 0 + Init%InData_SrvD%NumSC2Ctrl = 0 + Init%InData_SrvD%NumCtrl2SC = 0 END IF - CALL AllocAry(InitInData_SrvD%BlPitchInit, InitOutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) + CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - InitInData_SrvD%BlPitchInit = InitOutData_ED%BlPitch - CALL SrvD_Init( InitInData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & - SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), InitOutData_SrvD, ErrStat2, ErrMsg2 ) + if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them + CALL Cleanup() + RETURN + end if + + Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_SrvD) = .TRUE. - !IF ( InitOutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! + !IF ( Init%OutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -734,13 +710,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_SrvD%LinNames_y)) call move_alloc(InitOutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) - if (allocated(InitOutData_SrvD%LinNames_u)) call move_alloc(InitOutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) - if (allocated(InitOutData_SrvD%RotFrame_y)) call move_alloc(InitOutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_SrvD%RotFrame_u)) call move_alloc(InitOutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_SrvD%IsLoad_u )) call move_alloc(InitOutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_SrvD%LinNames_y)) call move_alloc(Init%OutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_SrvD%LinNames_u)) call move_alloc(Init%OutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_SrvD%RotFrame_y)) call move_alloc(Init%OutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_SrvD%RotFrame_u)) call move_alloc(Init%OutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_SrvD%IsLoad_u )) call move_alloc(Init%OutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(InitOutData_SrvD%WriteOutputHdr) + if (allocated(Init%OutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(Init%OutData_SrvD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -754,7 +730,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - IF ( InitOutData_SrvD%UseHSSBrake ) THEN + IF ( Init%OutData_SrvD%UseHSSBrake ) THEN IF ( p_FAST%CompAero == Module_AD14 ) THEN IF ( AD14%p%DYNINFL ) THEN CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) @@ -765,7 +741,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) ENDIF - END IF ! InitOutData_SrvD%UseHSSBrake + END IF ! Init%OutData_SrvD%UseHSSBrake END IF @@ -776,7 +752,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! get wave elevation data for visualization if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat2, ErrMsg2) + call SetVTKParameters_B4HD(p_FAST, Init%OutData_ED, Init%InData_HD, BD, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -797,26 +773,42 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompHydro == Module_HD ) THEN - InitInData_HD%Gravity = InitOutData_ED%Gravity - InitInData_HD%UseInputFile = .TRUE. - InitInData_HD%InputFile = p_FAST%HydroFile - InitInData_HD%OutRootName = p_FAST%OutFileRoot - InitInData_HD%TMax = p_FAST%TMax - InitInData_HD%hasIce = p_FAST%CompIce /= Module_None - + Init%InData_HD%Gravity = Init%OutData_ED%Gravity + Init%InData_HD%UseInputFile = .TRUE. + Init%InData_HD%InputFile = p_FAST%HydroFile + Init%InData_HD%OutRootName = p_FAST%OutFileRoot + Init%InData_HD%TMax = p_FAST%TMax + 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): - InitInData_HD%PtfmLocationX = p_FAST%TurbinePos(1) - InitInData_HD%PtfmLocationY = p_FAST%TurbinePos(2) + Init%InData_HD%PtfmLocationX = p_FAST%TurbinePos(1) + Init%InData_HD%PtfmLocationY = p_FAST%TurbinePos(2) - CALL HydroDyn_Init( InitInData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & - HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), InitOutData_HD, ErrStat2, ErrMsg2 ) + CALL HydroDyn_Init( Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & + HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), Init%OutData_HD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_HD) = .TRUE. CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + + allocate( y_FAST%Lin%Modules(MODULE_HD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_HD%LinNames_y)) call move_alloc(Init%OutData_HD%LinNames_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_HD%LinNames_u)) call move_alloc(Init%OutData_HD%LinNames_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_HD%LinNames_x)) call move_alloc(Init%OutData_HD%LinNames_x, y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_x ) +! LIN-TODO: Determine if we need to create this data even though we don't have rotating frames in HD + !if (allocated(Init%OutData_HD%RotFrame_y)) call move_alloc(Init%OutData_HD%RotFrame_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_y ) + !if (allocated(Init%OutData_HD%RotFrame_u)) call move_alloc(Init%OutData_HD%RotFrame_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_HD%DerivOrder_x)) call move_alloc(Init%OutData_HD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_HD%IsLoad_u )) call move_alloc(Init%OutData_HD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(Init%OutData_HD%WriteOutputHdr) + end if + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -843,21 +835,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompSub == Module_SD ) THEN IF ( p_FAST%CompHydro == Module_HD ) THEN - InitInData_SD%WtrDpth = InitOutData_HD%WtrDpth + Init%InData_SD%WtrDpth = Init%OutData_HD%WtrDpth ELSE - InitInData_SD%WtrDpth = 0.0_ReKi + Init%InData_SD%WtrDpth = 0.0_ReKi END IF - InitInData_SD%g = InitOutData_ED%Gravity - !InitInData_SD%UseInputFile = .TRUE. - InitInData_SD%SDInputFile = p_FAST%SubFile - InitInData_SD%RootName = p_FAST%OutFileRoot - InitInData_SD%TP_RefPoint = ED%Output(1)%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be - InitInData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be + Init%InData_SD%g = Init%OutData_ED%Gravity + !Init%InData_SD%UseInputFile = .TRUE. + Init%InData_SD%SDInputFile = p_FAST%SubFile + Init%InData_SD%RootName = p_FAST%OutFileRoot + Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be + Init%InData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be - CALL SD_Init( InitInData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & - SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), InitOutData_SD, ErrStat2, ErrMsg2 ) + CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & + SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_SD) = .TRUE. @@ -870,19 +862,33 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - InitInData_ExtPtfm%InputFile = p_FAST%SubFile -! InitInData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) - InitInData_ExtPtfm%Linearize = p_FAST%Linearize + Init%InData_ExtPtfm%InputFile = p_FAST%SubFile + Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + Init%InData_ExtPtfm%Linearize = p_FAST%Linearize + Init%InData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required - - CALL ExtPtfm_Init( InitInData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & + CALL ExtPtfm_Init( Init%InData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), & - ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), InitOutData_ExtPtfm, ErrStat2, ErrMsg2 ) + ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. CALL SetModuleSubstepTime(MODULE_ExtPtfm, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ExtPtfm).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_ExtPtfm%LinNames_y)) call move_alloc(Init%OutData_ExtPtfm%LinNames_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_y) + if (allocated(Init%OutData_ExtPtfm%LinNames_x)) call move_alloc(Init%OutData_ExtPtfm%LinNames_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_x) + if (allocated(Init%OutData_ExtPtfm%LinNames_u)) call move_alloc(Init%OutData_ExtPtfm%LinNames_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_u) + if (allocated(Init%OutData_ExtPtfm%RotFrame_y)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ExtPtfm%RotFrame_x)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ExtPtfm%RotFrame_u)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ExtPtfm%IsLoad_u )) call move_alloc(Init%OutData_ExtPtfm%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_ExtPtfm%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%NumOutputs = size(Init%OutData_ExtPtfm%WriteOutputHdr) + end if IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -928,26 +934,40 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! InitInData_MAP%rootname = p_FAST%OutFileRoot ! Output file name - InitInData_MAP%gravity = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_MAP%sea_density = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - InitInData_MAP%depth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn +! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name + Init%InData_MAP%gravity = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MAP%sea_density = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + Init%InData_MAP%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn ! differences for MAP++ - InitInData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name - InitInData_MAP%depth = -InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name + Init%InData_MAP%depth = -Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - + Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize - CALL MAP_Init( InitInData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & - MAPp%y, p_FAST%dt_module( MODULE_MAP ), InitOutData_MAP, ErrStat2, ErrMsg2 ) + CALL MAP_Init( Init%InData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MAP) = .TRUE. CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + + allocate( y_FAST%Lin%Modules(Module_MAP)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_MAP%LinInitOut%LinNames_y)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_y ) + if (allocated(Init%OutData_MAP%LinInitOut%LinNames_u)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_u ) +! LIN-TODO: Determine if we need to create this data even though we don't have rotating frames in MAP + !if (allocated(Init%OutData_MAP%LinInitOut%RotFrame_y)) call move_alloc(Init%OutData_MAP%LinInitOut%RotFrame_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_y ) + !if (allocated(Init%OutData_MAP%LinInitOut%RotFrame_u)) call move_alloc(Init%OutData_MAP%LinInitOut%RotFrame_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_MAP%LinInitOut%IsLoad_u )) call move_alloc(Init%OutData_MAP%LinInitOut%IsLoad_u ,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(Init%OutData_MAP%WriteOutputHdr) + end if + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -957,16 +977,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_MD) THEN - InitInData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_MD%RootName = p_FAST%OutFileRoot + 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 - InitInData_MD%PtfmInit = InitOutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from InitOutData_ED, not x_ED - InitInData_MD%g = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_MD%rhoW = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - InitInData_MD%WtrDepth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + 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 = Init%OutData_ED%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 - CALL MD_Init( InitInData_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 ), InitOutData_MD, ErrStat2, ErrMsg2 ) + 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 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MD) = .TRUE. @@ -982,17 +1002,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - InitInData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) - - InitInData_FEAM%PtfmInit = InitOutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from InitOutData_ED, not x_ED - InitInData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) - InitInData_FEAM%gravity = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_FEAM%WtrDens = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn -! InitInData_FEAM%depth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) + + Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED + Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + Init%InData_FEAM%gravity = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_FEAM%WtrDens = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn +! Init%InData_FEAM%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - CALL FEAM_Init( InitInData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & - FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), InitOutData_FEAM, ErrStat2, ErrMsg2 ) + CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & + FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. @@ -1008,12 +1028,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - InitInData_Orca%InputFile = p_FAST%MooringFile - InitInData_Orca%RootName = p_FAST%OutFileRoot - InitInData_Orca%TMax = p_FAST%TMax + Init%InData_Orca%InputFile = p_FAST%MooringFile + Init%InData_Orca%RootName = p_FAST%OutFileRoot + Init%InData_Orca%TMax = p_FAST%TMax - CALL Orca_Init( InitInData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & - Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), InitOutData_Orca, ErrStat2, ErrMsg2 ) + CALL Orca_Init( Init%InData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & + Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), Init%OutData_Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. @@ -1074,14 +1094,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ IF ( p_FAST%CompIce == Module_IceF ) THEN - InitInData_IceF%InputFile = p_FAST%IceFile - InitInData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) - InitInData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi - InitInData_IceF%MSL2SWL = InitOutData_HD%MSL2SWL - InitInData_IceF%gravity = InitOutData_ED%Gravity - - CALL IceFloe_Init( InitInData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & - IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), InitOutData_IceF, ErrStat2, ErrMsg2 ) + Init%InData_IceF%InputFile = p_FAST%IceFile + Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) + Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi + Init%InData_IceF%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceF%gravity = Init%OutData_ED%Gravity + + CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & + IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IceF) = .TRUE. @@ -1097,16 +1117,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - InitInData_IceD%InputFile = p_FAST%IceFile - InitInData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' - InitInData_IceD%MSL2SWL = InitOutData_HD%MSL2SWL - InitInData_IceD%WtrDens = InitOutData_HD%WtrDens - InitInData_IceD%gravity = InitOutData_ED%Gravity - InitInData_IceD%TMax = p_FAST%TMax - InitInData_IceD%LegNum = 1 + Init%InData_IceD%InputFile = p_FAST%IceFile + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' + Init%InData_IceD%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceD%WtrDens = Init%OutData_HD%WtrDens + Init%InData_IceD%gravity = Init%OutData_ED%Gravity + Init%InData_IceD%TMax = p_FAST%TMax + Init%InData_IceD%LegNum = 1 - CALL IceD_Init( InitInData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & - IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & + IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), Init%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IceD) = .TRUE. @@ -1115,7 +1135,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! now initialize IceD for additional legs (if necessary) dt_IceD = p_FAST%dt_module( MODULE_IceD ) - p_FAST%numIceLegs = InitOutData_IceD%numLegs + p_FAST%numIceLegs = Init%OutData_IceD%numLegs IF (p_FAST%numIceLegs > IceD_MaxLegs) THEN CALL SetErrStat(ErrID_Fatal,'IceDyn-FAST coupling is supported for up to '//TRIM(Num2LStr(IceD_MaxLegs))//' legs, but ' & @@ -1124,11 +1144,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, DO i=2,p_FAST%numIceLegs ! basically, we just need IceDyn to set up its meshes for inputs/outputs and possibly initial values for states - InitInData_IceD%LegNum = i - InitInData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) + Init%InData_IceD%LegNum = i + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) - CALL IceD_Init( InitInData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & - IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & + IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, Init%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n IceD modules with n timesteps. @@ -1149,9 +1169,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) ! ........................ - CALL FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, InitOutData_AD14, InitOutData_AD, & - InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & - InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1165,13 +1183,18 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN - END IF + ELSEIF (ErrStat /= ErrID_None) THEN + ! a little work-around in case the mesh mapping info messages get too long + CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) + ErrStat = ErrID_None + ErrMsg = "" + END IF ! ------------------------------------------------------------------------- ! Initialize for linearization: ! ------------------------------------------------------------------------- if ( p_FAST%Linearize ) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, InitOutData_ED%NumBl, ErrStat2, ErrMsg2) + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, Init%OutData_ED%NumBl, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -1185,7 +1208,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize data for VTK output ! ------------------------------------------------------------------------- if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_HD, InitOutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%InData_HD, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1203,7 +1226,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ------------------------------------------------------------------------- m_FAST%t_global = t_initial - m_FAST%NextLinTimeIndx = 1 ! Initialize external inputs for first step if ( p_FAST%CompServo == MODULE_SrvD ) then @@ -1231,91 +1253,8 @@ SUBROUTINE Cleanup() !............................................................................................................................... ! Destroy initializion data !............................................................................................................................... - - CALL ED_DestroyInitInput( InitInData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ED_DestroyInitOutput( InitOutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL BD_DestroyInitInput( InitInData_BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ALLOCATED(InitOutData_BD)) THEN - DO i=1,p_FAST%nBeams - CALL BD_DestroyInitOutput( InitOutData_BD(i), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END DO - DEALLOCATE(InitOutData_BD) - END IF - - CALL AD14_DestroyInitInput( InitInData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD14_DestroyInitOutput( InitOutData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL AD_DestroyInitInput( InitInData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD_DestroyInitOutput( InitOutData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL InflowWind_DestroyInitInput( InitInData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL InflowWind_DestroyInitOutput( InitOutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL OpFM_DestroyInitInput( InitInData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL OpFM_DestroyInitOutput( InitOutData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL SrvD_DestroyInitInput( InitInData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL SrvD_DestroyInitOutput( InitOutData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL SD_DestroyInitInput( InitInData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL SD_DestroyInitOutput( InitOutData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL ExtPtfm_DestroyInitInput( InitInData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitOutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL MAP_DestroyInitInput( InitInData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MAP_DestroyInitOutput( InitOutData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL FEAM_DestroyInitInput( InitInData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL FEAM_DestroyInitOutput( InitOutData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL MD_DestroyInitInput( InitInData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MD_DestroyInitOutput( InitOutData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL Orca_DestroyInitInput( InitInData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Orca_DestroyInitOutput( InitOutData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL IceFloe_DestroyInitInput( InitInData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL IceFloe_DestroyInitOutput( InitOutData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL IceD_DestroyInitInput( InitInData_IceD, ErrStat2, ErrMsg2 ) + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL IceD_DestroyInitOutput( InitOutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE Cleanup @@ -1363,72 +1302,22 @@ FUNCTION GetVersion(ThisProgVer) RETURN END FUNCTION GetVersion -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine parses and compiles the relevant version and compile data for a givne program -subroutine GetProgramMetadata(ThisProgVer, name, version, git_commit, architecture, precision) - - TYPE(ProgDesc), INTENT(IN ) :: ThisProgVer !< program name/date/version description - character(200), intent(out) :: name, version - character(200), intent(out) :: git_commit, architecture, precision - - name = trim(ThisProgVer%Name) - version = trim(ThisProgVer%Ver) - - git_commit = QueryGitVersion() - - architecture = TRIM(Num2LStr(BITS_IN_ADDR))//' bit' - - if (ReKi == SiKi) then - precision = 'single' - else if (ReKi == R8Ki) then - precision = 'double' - else - precision = 'unknown' - end if - -end subroutine GetProgramMetadata - !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is called at the start (or restart) of a FAST program (or FAST.Farm). It initializes the NWTC subroutine library, !! displays the copyright notice, and displays some version information (including addressing scheme and precision). SUBROUTINE FAST_ProgStart(ThisProgVer) TYPE(ProgDesc), INTENT(IN) :: ThisProgVer !< program name/date/version description - character(200) :: name, version - character(200) :: git_commit, architecture, precision - character(200) :: execution_date, execution_time, execution_zone ! ... Initialize NWTC Library (open console, set pi constants) ... ! sets the pi constants, open console for output, etc... CALL NWTC_Init( ProgNameIN=ThisProgVer%Name, EchoLibVer=.FALSE. ) ! Display the copyright notice - CALL DispCopyrightLicense( ThisProgVer ) + CALL DispCopyrightLicense( ThisProgVer%Name ) - ! Display the program metadata - call GetProgramMetadata(ThisProgVer, name, version, git_commit, architecture, precision) - - call wrscr(trim(name)//'-'//trim(git_commit)) - call wrscr('Compile Info:') - call wrscr(' - Architecture: '//trim(architecture)) - call wrscr(' - Precision: '//trim(precision)) - call wrscr(' - Date: '//__DATE__) - call wrscr(' - Time: '//__TIME__) - ! use iso_fortran_env for compiler_version() and compiler_options() - ! call wrscr(' - Compiler: '//trim(compiler_version())) - ! call wrscr(' - Options: '//trim(compiler_options())) + CALL DispCompileRuntimeInfo - call date_and_time(execution_date, execution_time, execution_zone) - - call wrscr('Execution Info:') - call wrscr(' - Date: '//trim(execution_date(5:6)//'/'//execution_date(7:8)//'/'//execution_date(1:4))) - call wrscr(' - Time: '//trim(execution_time(1:2)//':'//execution_time(3:4)//':'//execution_time(5:6))//trim(execution_zone)) - - call wrscr('') - - ! CALL WrScr( ' Running '//TRIM(GetVersion(ThisProgVer))//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) - END SUBROUTINE FAST_ProgStart - !---------------------------------------------------------------------------------------------------------------------------------- !> This routine gets the name of the FAST input file from the command line. It also returns a logical indicating if this there !! was a "DWM" argument after the file name. @@ -1465,13 +1354,14 @@ END SUBROUTINE GetInputFileName !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine checks for command-line arguments, gets the root name of the input files !! (including full path name), and creates the names of the output files. -SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) +SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< The output data for the FAST (glue-code) simulation REAL(DbKi), INTENT(IN) :: t_initial !< the beginning time of the simulation INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -1491,7 +1381,7 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu CHARACTER(*), PARAMETER :: RoutineName = "FAST_Init" INTEGER(IntKi) :: ErrStat2 - CHARACTER(1024) :: ErrMsg2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Initialize some variables ErrStat = ErrID_None @@ -1522,6 +1412,7 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END IF end if + p%VTK_OutFileRoot = p%OutFileRoot !initialize this here in case of error before it is set later !............................................................................................................................... @@ -1572,9 +1463,15 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu !............................................................................................................................... ! Read the primary file for the glue code: !............................................................................................................................... - CALL FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) + CALL FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! make sure some linearization variables are consistant + if (.not. p%Linearize) p%CalcSteady = .false. + if (.not. p%CalcSteady) p%TrimCase = TrimCase_none + m_FAST%Lin%FoundSteady = .false. + p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor? + ! overwrite TMax if necessary) IF (PRESENT(TMax)) THEN p%TMax = TMax @@ -1601,7 +1498,8 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END IF ELSEIF ( p%CompMooring == Module_Orca ) THEN p%TurbineType = Type_Offshore_Floating - !bjj: what about ExtPtfm_MCKF ??? + ELSEIF ( p%CompSub == Module_ExtPtfm ) THEN + p%TurbineType = Type_Offshore_Fixed ELSE p%TurbineType = Type_LandBased END IF @@ -1610,16 +1508,16 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu p%n_TMax_m1 = CEILING( ( (p%TMax - t_initial) / p%DT ) ) - 1 ! We're going to go from step 0 to n_TMax (thus the -1 here) if (p%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error - p%TChanLen = 10 + p%TChanLen = MinChanLen else - p%TChanLen = max( 10, int(log10(p%TMax))+7 ) + p%TChanLen = max( MinChanLen, int(log10(p%TMax))+7 ) end if p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' !............................................................................................................................... ! Do some error checking on the inputs (validation): !............................................................................................................................... - call ValidateInputData(p, ErrStat2, ErrMsg2) + call ValidateInputData(p, m_FAST, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1631,9 +1529,10 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END SUBROUTINE FAST_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates FAST data. -SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) +SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< The misc data for the FAST (glue-code) simulation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -1673,11 +1572,11 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( p%FmtWidth /= ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & - TRIM(Num2LStr(p%FmtWidth))//' instead of '//TRIM(Num2LStr(ChanLen))//' characters.', ErrStat, ErrMsg, RoutineName ) + IF ( p%WrTxtOutFile .and. p%FmtWidth < MinChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(p%FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) IF ( p%WrTxtOutFile .AND. p%TChanLen > ChanLen ) THEN ! ( p%TMax > 9999.999_DbKi ) - CALL SetErrStat( ErrID_Warn, 'TMax is too large for a 10-character time column in text tabular (time-marching) output files.'// & + CALL SetErrStat( ErrID_Warn, 'TMax is too large for a '//trim(num2lstr(ChanLen))//'-character time column in text tabular (time-marching) output files.'// & ' Postprocessors with this limitation may not work.', ErrStat, ErrMsg, RoutineName ) END IF @@ -1728,21 +1627,45 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) if ( p%WrVTK == VTK_Unknown ) then - call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), or 2 (animation).', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).', ErrStat, ErrMsg, RoutineName) else if ( p%VTK_type == VTK_Unknown ) then call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) ! note I'm not going to write that 4 (old) is an option - end if + end if + + if (p%WrVTK == VTK_ModeShapes .and. .not. p%Linearize) then + call SetErrStat(ErrID_Fatal, 'WrVTK cannot be 3 (mode shapes) when Linearize is false. (Mode shapes require linearization analysis.)', ErrStat, ErrMsg, RoutineName) + end if end if - if (p%Linearize) then - if (p%LinTimes(1) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) - do i=2,size(p%LinTimes) - if (p%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) - if (p%LinTimes(i) <= p%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) - end do + + if (p%CalcSteady) then + if (p%NLinTimes < 1) call SetErrStat(ErrID_Fatal,'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + if (p%TrimCase /= TrimCase_yaw .and. p%TrimCase /= TrimCase_torque .and. p%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,'TrimCase must be either 1, 2, or 3.',ErrStat, ErrMsg, RoutineName) + end if + + if (p%TrimTol <= epsilon(p%TrimTol)) call SetErrStat(ErrID_Fatal,'TrimTol must be larger than '//trim(num2lstr(epsilon(p%TrimTol)))//'.',ErrStat, ErrMsg, RoutineName) + if (p%Twr_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + if (p%Bld_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Bld_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + else + + if (.not. allocated(m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, 'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + else + do i=1,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) + end do + do i=2,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) <= m_FAST%Lin%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) + end do + + if (m_FAST%Lin%LinTimes(p%NLinTimes) > p%TMax) call SetErrStat(ErrID_Info, 'Tmax is less than the last linearization time. Linearization analysis will not be performed after TMax.',ErrStat, ErrMsg, RoutineName) + end if + + end if if (p%LinInputs < LIN_NONE .or. p%LinInputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinInputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) if (p%LinOutputs < LIN_NONE .or. p%LinOutputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinOutputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) @@ -1757,9 +1680,9 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) ! now, make sure we haven't asked for any modules that we can't yet linearize: if (p%CompInflow == MODULE_OpFM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the OpenFOAM coupling.',ErrStat, ErrMsg, RoutineName) if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) - if (p%CompHydro == MODULE_HD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the HydroDyn module.',ErrStat, ErrMsg, RoutineName) - if (p%CompSub /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the substructure modules.',ErrStat, ErrMsg, RoutineName) - if (p%CompMooring /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the mooring modules.',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) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the any of the substructure modules.',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%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) end if @@ -1776,7 +1699,7 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) IF ( .NOT. EqualRealNos( p%DT_out, p%DT ) ) THEN IF ( p%DT_out < p%DT ) THEN CALL SetErrStat( ErrID_Fatal, 'DT_out must be at least DT ('//TRIM(Num2LStr(p%DT))//' s).', ErrStat, ErrMsg, RoutineName ) - ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * NINT(p%DT_out / p%DT ) ) ) THEN + ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * p%n_DT_Out ) ) THEN CALL SetErrStat( ErrID_Fatal, 'DT_out must be an integer multiple of DT.', ErrStat, ErrMsg, RoutineName ) END IF END IF @@ -1786,32 +1709,14 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the output for the glue code, including writing the header for the primary output file. -SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, InitOutData_AD14, InitOutData_AD, & - InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & - InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat, ErrMsg ) +SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs - - TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< Initialization output for ElastoDyn - TYPE(BD_InitOutputType), INTENT(IN) :: InitOutData_BD(:) !< Initialization output for BeamDyn (each instance) - TYPE(SrvD_InitOutputType), INTENT(IN) :: InitOutData_SrvD !< Initialization output for ServoDyn - TYPE(AD14_InitOutputType), INTENT(IN) :: InitOutData_AD14 !< Initialization output for AeroDyn14 - TYPE(AD_InitOutputType), INTENT(IN) :: InitOutData_AD !< Initialization output for AeroDyn - TYPE(InflowWind_InitOutputType),INTENT(IN) :: InitOutData_IfW !< Initialization output for InflowWind - TYPE(OpFM_InitOutputType), INTENT(IN) :: InitOutData_OpFM !< Initialization output for OpenFOAM - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: InitOutData_HD !< Initialization output for HydroDyn - TYPE(SD_InitOutputType), INTENT(IN) :: InitOutData_SD !< Initialization output for SubDyn - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: InitOutData_ExtPtfm !< Initialization output for ExtPtfm_MCKF - TYPE(MAP_InitOutputType), INTENT(IN) :: InitOutData_MAP !< Initialization output for MAP - TYPE(Orca_InitOutputType), INTENT(IN) :: InitOutData_Orca !< Initialization output for OrcaFlex interface - TYPE(FEAM_InitOutputType), INTENT(IN) :: InitOutData_FEAM !< Initialization output for FEAMooring - TYPE(MD_InitOutputType), INTENT(IN) :: InitOutData_MD !< Initialization output for MoorDyn - TYPE(IceFloe_InitOutputType), INTENT(IN) :: InitOutData_IceF !< Initialization output for IceFloe - TYPE(IceD_InitOutputType), INTENT(IN) :: InitOutData_IceD !< Initialization output for IceDyn + TYPE(FAST_InitData), INTENT(IN) :: Init !< Initialization data for all modules INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message corresponding to ErrStat @@ -1820,7 +1725,6 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! Local variables. INTEGER(IntKi) :: I, J ! Generic index for DO loops. - INTEGER(IntKi) :: indxLast ! The index of the last value to be written to an array INTEGER(IntKi) :: indxNext ! The index of the next value to be written to an array INTEGER(IntKi) :: NumOuts ! number of channels to be written to the output file(s) @@ -1838,68 +1742,68 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! and save the module version info for later use, too: !...................................................... - y_FAST%Module_Ver( Module_ED ) = InitOutData_ED%Ver - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) IF ( p_FAST%CompElast == Module_BD ) THEN - y_FAST%Module_Ver( Module_BD ) = InitOutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_BD ) = Init%OutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_BD ))) END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - y_FAST%Module_Ver( Module_IfW ) = InitOutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_IfW ) = Init%OutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IfW ))) ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN - y_FAST%Module_Ver( Module_OpFM ) = InitOutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_OpFM ) = Init%OutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_OpFM ))) END IF IF ( p_FAST%CompAero == Module_AD14 ) THEN - y_FAST%Module_Ver( Module_AD14 ) = InitOutData_AD14%Ver + y_FAST%Module_Ver( Module_AD14 ) = Init%OutData_AD14%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD14 ) )) ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - y_FAST%Module_Ver( Module_AD ) = InitOutData_AD%Ver + y_FAST%Module_Ver( Module_AD ) = Init%OutData_AD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD ) )) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - y_FAST%Module_Ver( Module_SrvD ) = InitOutData_SrvD%Ver + y_FAST%Module_Ver( Module_SrvD ) = Init%OutData_SrvD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SrvD ))) END IF IF ( p_FAST%CompHydro == Module_HD ) THEN - y_FAST%Module_Ver( Module_HD ) = InitOutData_HD%Ver + y_FAST%Module_Ver( Module_HD ) = Init%OutData_HD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_HD ))) END IF IF ( p_FAST%CompSub == Module_SD ) THEN - y_FAST%Module_Ver( Module_SD ) = InitOutData_SD%Ver + y_FAST%Module_Ver( Module_SD ) = Init%OutData_SD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SD ))) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - y_FAST%Module_Ver( Module_ExtPtfm ) = InitOutData_ExtPtfm%Ver + y_FAST%Module_Ver( Module_ExtPtfm ) = Init%OutData_ExtPtfm%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ExtPtfm ))) END IF IF ( p_FAST%CompMooring == Module_MAP ) THEN - y_FAST%Module_Ver( Module_MAP ) = InitOutData_MAP%Ver + y_FAST%Module_Ver( Module_MAP ) = Init%OutData_MAP%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MAP ))) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - y_FAST%Module_Ver( Module_MD ) = InitOutData_MD%Ver + y_FAST%Module_Ver( Module_MD ) = Init%OutData_MD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MD ))) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - y_FAST%Module_Ver( Module_FEAM ) = InitOutData_FEAM%Ver + y_FAST%Module_Ver( Module_FEAM ) = Init%OutData_FEAM%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_FEAM ))) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - y_FAST%Module_Ver( Module_Orca ) = InitOutData_Orca%Ver + y_FAST%Module_Ver( Module_Orca ) = Init%OutData_Orca%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_Orca))) END IF IF ( p_FAST%CompIce == Module_IceF ) THEN - y_FAST%Module_Ver( Module_IceF ) = InitOutData_IceF%Ver + y_FAST%Module_Ver( Module_IceF ) = Init%OutData_IceF%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceF ))) ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - y_FAST%Module_Ver( Module_IceD ) = InitOutData_IceD%Ver + y_FAST%Module_Ver( Module_IceD ) = Init%OutData_IceD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceD ))) END IF @@ -1911,25 +1815,26 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init !y_FAST%numOuts(Module_InfW) = 3 !hack for now: always output 3 wind speeds at hub-height - IF ( ALLOCATED( InitOutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(InitOutData_IfW%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(InitOutData_OpFM%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(InitOutData_ED%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(Init%OutData_OpFM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) do i=1,p_FAST%nBeams - IF ( ALLOCATED( InitOutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(InitOutData_BD(i)%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) end do +!ad14 doesn't have outputs: y_FAST%numOuts(Module_AD14) = 0 - IF ( ALLOCATED( InitOutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(InitOutData_AD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(InitOutData_SrvD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(InitOutData_HD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(InitOutData_SD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(InitOutData_ExtPtfm%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(InitOutData_MAP%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(InitOutData_FEAM%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(InitOutData_MD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(InitOutData_Orca%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(InitOutData_IceF%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(InitOutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs + IF ( ALLOCATED( Init%OutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(Init%OutData_SrvD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(Init%OutData_HD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(Init%OutData_SD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(Init%OutData_ExtPtfm%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(Init%OutData_MAP%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(Init%OutData_FEAM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(Init%OutData_MD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(Init%OutData_Orca%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(Init%OutData_IceF%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(Init%OutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs !...................................................... ! Initialize the output channel names and units @@ -1944,35 +1849,31 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' - indxLast = 1 indxNext = 2 + DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind + y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO - IF ( y_FAST%numOuts(Module_IfW) > 0_IntKi ) THEN - indxLast = indxNext + y_FAST%numOuts(Module_IfW) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_IfW%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_IfW%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_OpFM) > 0_IntKi ) THEN - indxLast = indxNext + y_FAST%numOuts(Module_OpFM) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_OpFM%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_OpFM%WriteOutputUnt - indxNext = indxLast + 1 - END IF - + DO i=1,y_FAST%numOuts(Module_OpFM) !OpenFOAM + y_FAST%ChannelNames(indxNext) = Init%OutData_OpFM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_OpFM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO - IF ( y_FAST%numOuts(Module_ED) > 0_IntKi ) THEN !ElastoDyn - indxLast = indxNext + y_FAST%numOuts(Module_ED) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_ED%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_ED%WriteOutputUnt - indxNext = indxLast + 1 - END IF + DO i=1,y_FAST%numOuts(Module_ED) !ElastoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_ED%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ED%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO IF ( y_FAST%numOuts(Module_BD) > 0_IntKi ) THEN !BeamDyn do i=1,p_FAST%nBeams - if ( allocated(InitOutData_BD(i)%WriteOutputHdr) ) then - do j=1,size(InitOutData_BD(i)%WriteOutputHdr) - y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(InitOutData_BD(i)%WriteOutputHdr(j)) - y_FAST%ChannelUnits(indxNext) = InitOutData_BD(i)%WriteOutputUnt(j) + if ( allocated(Init%OutData_BD(i)%WriteOutputHdr) ) then + do j=1,size(Init%OutData_BD(i)%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(Init%OutData_BD(i)%WriteOutputHdr(j)) + y_FAST%ChannelUnits(indxNext) = Init%OutData_BD(i)%WriteOutputUnt(j) indxNext = indxNext + 1 end do ! j end if @@ -1980,77 +1881,73 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init END IF - ! none for AeroDyn14 - - IF ( y_FAST%numOuts(Module_AD) > 0_IntKi ) THEN !AeroDyn - indxLast = indxNext + y_FAST%numOuts(Module_AD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_AD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_AD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_SrvD) > 0_IntKi ) THEN !ServoDyn - indxLast = indxNext + y_FAST%numOuts(Module_SrvD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_SrvD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_SrvD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - IF ( y_FAST%numOuts(Module_HD) > 0_IntKi ) THEN !HydroDyn - indxLast = indxNext + y_FAST%numOuts(Module_HD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_HD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_HD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_SD) > 0_IntKi ) THEN !SubDyn - indxLast = indxNext + y_FAST%numOuts(Module_SD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_SD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_SD%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_ExtPtfm) > 0_IntKi ) THEN !ExtPtfm_MCKF - indxLast = indxNext + y_FAST%numOuts(Module_ExtPtfm) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_ExtPtfm%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_ExtPtfm%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_MAP) > 0_IntKi ) THEN !MAP - indxLast = indxNext + y_FAST%numOuts(Module_MAP) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_MAP%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_MAP%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_MD) > 0_IntKi ) THEN !MoorDyn - indxLast = indxNext + y_FAST%numOuts(Module_MD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_MD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_MD%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_FEAM) > 0_IntKi ) THEN !FEAMooring - indxLast = indxNext + y_FAST%numOuts(Module_FEAM) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_FEAM%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_FEAM%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_Orca) > 0_IntKi ) THEN !OrcaFlex - indxLast = indxNext + y_FAST%numOuts(Module_Orca) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_Orca%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_Orca%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_IceF) > 0_IntKi ) THEN !IceFloe - indxLast = indxNext + y_FAST%numOuts(Module_IceF) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_IceF%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_IceF%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn + ! none for AeroDyn14 + + DO i=1,y_FAST%numOuts(Module_AD) !AeroDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_AD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_AD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SrvD) !ServoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SrvD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SrvD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_HD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_HD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SD) !SubDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_ExtPtfm) !ExtPtfm_MCKF + y_FAST%ChannelNames(indxNext) = Init%OutData_ExtPtfm%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ExtPtfm%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MAP) !MAP + y_FAST%ChannelNames(indxNext) = Init%OutData_MAP%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MAP%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MD) !MoorDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_MD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_FEAM) !FEAMooring + y_FAST%ChannelNames(indxNext) = Init%OutData_FEAM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_FEAM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_Orca) !OrcaFlex + y_FAST%ChannelNames(indxNext) = Init%OutData_Orca%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_Orca%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_IceF) !IceFloe + y_FAST%ChannelNames(indxNext) = Init%OutData_IceF%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceF%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + IF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn DO I=1,p_FAST%numIceLegs - DO J=1,SIZE(InitOutData_IceD%WriteOutputHdr) - y_FAST%ChannelNames(indxNext) =TRIM(InitOutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? - y_FAST%ChannelUnits(indxNext) = InitOutData_IceD%WriteOutputUnt(J) + DO J=1,SIZE(Init%OutData_IceD%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) =TRIM(Init%OutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceD%WriteOutputUnt(J) indxNext = indxNext + 1 END DO ! J END DO ! I @@ -2063,6 +1960,17 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init IF (p_FAST%WrTxtOutFile) THEN + y_FAST%ActualChanLen = max( MinChanLen, p_FAST%FmtWidth ) + DO I=1,NumOuts + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelNames(I)) ) + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + + y_FAST%OutFmt_a = '"'//p_FAST%Delim//'"'//p_FAST%OutFmt ! format for array elements from individual modules + if (p_FAST%FmtWidth < y_FAST%ActualChanLen) then + y_FAST%OutFmt_a = trim(y_FAST%OutFmt_a)//','//trim(num2lstr(y_FAST%ActualChanLen - p_FAST%FmtWidth))//'x' + end if + CALL GetNewUnit( y_FAST%UnOu, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2081,12 +1989,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init !...................................................... ! Write the names of the output parameters on one line: !...................................................... + if (p_FAST%Delim /= " ") then ! trim trailing spaces if not space delimited: - CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1) ) + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelNames(1)) ) ! first one is time, with a special format - DO I=2,NumOuts - CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I) ) - ENDDO ! I + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelNames(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1)(1:p_FAST%TChanLen) ) ! first one is time, with a special format + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if WRITE (y_FAST%UnOu,'()') @@ -2094,11 +2011,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! Write the units of the output parameters on one line: !...................................................... - CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1) ) + if (p_FAST%Delim /= " ") then + + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelUnits(1)) ) - DO I=2,NumOuts - CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I) ) - ENDDO ! I + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1)(1:p_FAST%TChanLen) ) + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if WRITE (y_FAST%UnOu,'()') @@ -2113,6 +2040,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init y_FAST%NOutSteps = CEILING ( (p_FAST%TMax - p_FAST%TStart) / p_FAST%DT_OUT ) + 1 CALL AllocAry( y_FAST%AllOutData, NumOuts-1, y_FAST%NOutSteps, 'AllOutData', ErrStat, ErrMsg ) + y_FAST%AllOutData = 0.0_ReKi IF ( ErrStat >= AbortErrLev ) RETURN IF ( p_FAST%WrBinMod == FileFmtID_WithTime ) THEN ! we store the entire time array @@ -2137,12 +2065,13 @@ END SUBROUTINE FAST_InitOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary FAST input file, does some validation, and places the values it reads in the !! parameter structure (p). It prints to an echo file if requested. -SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, ErrMsg ) +SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data LOGICAL, INTENT(IN) :: OverrideAbortErrLev !< Determines if we should override AbortErrLev INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -2150,7 +2079,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err ! Local variables: REAL(DbKi) :: TmpRate ! temporary variable to read VTK_fps before converting to #steps based on DT - REAL(DbKi) :: VTK_fps ! temporary variable to read VTK_fps before converting to #steps based on DT REAL(DbKi) :: TmpTime ! temporary variable to read SttsTime and ChkptTime before converting to #steps based on DT INTEGER(IntKi) :: I ! loop counter INTEGER(IntKi) :: UnIn ! Unit number for reading file @@ -2159,7 +2087,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err INTEGER(IntKi) :: IOS ! Temporary Error status INTEGER(IntKi) :: ErrStat2 ! Temporary Error status INTEGER(IntKi) :: OutFileFmt ! An integer that indicates what kind of tabular output should be generated (1=text, 2=binary, 3=both) - INTEGER(IntKi) :: NLinTimes ! An integer that indicates how many times to linearize LOGICAL :: Echo ! Determines if an echo file should be written LOGICAL :: TabDelim ! Determines if text output should be delimited by tabs (true) or space (false) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message @@ -2668,6 +2595,8 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if END IF + p%n_DT_Out = NINT( p%DT_Out / p%DT ) + ! TStart - Time to begin tabular output (s): CALL ReadVar( UnIn, InputFile, p%TStart, "TStart", "Time to begin tabular output (s)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2676,44 +2605,60 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if + + !> OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 4: HDF5 [.h5], add for combinations} + !! + !! Combinations of output files are possible by adding the values corresponding to each file. The possible combination of options are therefore + !! + !! | `OutFileFmt` | Description | + !! |:------------:|:---------------------------------------------------------------------| + !! | 1 | Text file only `.out` | + !! | 2 | Binary file only `.outb` | + !! | 3 | Text and binary files | + !! | 4 | uncompressed binary file `.outbu` | + !! | 5 | Text and uncompressed binary files | + !! | 6 => 4 | Binary (not written) and uncompressed binary files; same as 4 | + !! | 7 => 5 | Text, Binary (not written), and uncompressed binary files; same as 5 | + !! + ! OutFileFmt - Format for tabular (time-marching) output file(s) (1: text file [.out], 2: binary file [.outb], 3: both) (-): - CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) (0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary) (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) {0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary, 4: uncompressed binary .outb]; add for combinations) (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if + + if (OutFileFmt == 0) OutFileFmt = 5 + + ! convert integer to binary representation of which file formats to generate: + p%WrTxtOutFile = mod(OutFileFmt,2) == 1 -#if defined COMPILE_SIMULINK || defined COMPILE_LABVIEW - !bjj: 2015-03-03: not sure this is still necessary... - p%WrBinMod = FileFmtID_WithTime ! We cannot guarantee the output time step is constant in binary files -#else - p%WrBinMod = FileFmtID_WithoutTime ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) -#endif - - SELECT CASE (OutFileFmt) - CASE (0_IntKi) - ! This is an undocumented feature for the regression testing system. It writes both text and binary output, but the binary is stored as uncompressed double floating point data instead of compressed int16 data. - p%WrBinOutFile = .TRUE. - p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) - p%WrTxtOutFile = .TRUE. - CASE (1_IntKi) - p%WrBinOutFile = .FALSE. - p%WrTxtOutFile = .TRUE. - CASE (2_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .FALSE. - CASE (3_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .TRUE. - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, "FAST's OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - END SELECT + OutFileFmt = OutFileFmt / 2 ! integer division + p%WrBinOutFile = mod(OutFileFmt,2) == 1 + + OutFileFmt = OutFileFmt / 2 ! integer division + if (mod(OutFileFmt,2) == 1) then + ! This is a feature for the regression testing system. It writes binary output stored as uncompressed double floating point data instead of compressed int16 data. + ! If the compressed binary version was requested, that will not be generated + if (p%WrBinOutFile) then + call SetErrStat(ErrID_Warn,'Binary compressed file will not be generated because the uncompressed version was also requested.', ErrStat, ErrMsg, RoutineName) + else + p%WrBinOutFile = .true. + end if + p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) + else + p%WrBinMod = FileFmtID_ChanLen_In ! A format specifier for the binary output file format (4=don't include time channel; do include channel width; do pack data) + end if + + OutFileFmt = OutFileFmt / 2 ! integer division + if (OutFileFmt /= 0) then + call SetErrStat( ErrID_Fatal, "OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) + call cleanup() + return + end if + ! TabDelim - Use tab delimiters in text tabular output file? (flag): CALL ReadVar( UnIn, InputFile, TabDelim, "TabDelim", "Use tab delimiters in text tabular output file? (flag)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2754,28 +2699,66 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if - ! NLinTimes - Number of times to linearize (-) [>=1] - CALL ReadVar( UnIn, InputFile, NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + + ! CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) + CALL ReadVar( UnIn, InputFile, p%CalcSteady, "CalcSteady", "Calculate a steady-state periodic operating point before linearization? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimCase, "TrimCase", "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimTol, "TrimTol", "Tolerance for the rotational speed convergence (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) + CALL ReadVar( UnIn, InputFile, p%TrimGain, "TrimGain", "Proportional gain for the rotational speed error (>0) (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Twr_Kdmp, "Twr_Kdmp", "Damping factor for the tower (N/(m/s))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Bld_Kdmp, "Bld_Kdmp", "Damping factor for the blades (N/(m/s))", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if - + + ! NLinTimes - Number of times to linearize (or number of equally spaced azimuth steps in periodic linearized model) (-) [>=1] + CALL ReadVar( UnIn, InputFile, p%NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if (.not. p%Linearize) then + p%CalcSteady = .false. + p%NLinTimes = 0 + end if + ! LinTimes - Times to linearize (s) [1 to NLinTimes] - if (NLinTimes >= 1) then - call AllocAry( p%LinTimes, NLinTimes, 'p%LinTimes', ErrStat2, ErrMsg2 ) + if (.not. p%CalcSteady .and. p%NLinTimes >= 1 ) then + call AllocAry( m_FAST%Lin%LinTimes, p%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat < AbortErrLev) then - CALL ReadAry( UnIn, InputFile, p%LinTimes, NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) - end if + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadAry( UnIn, InputFile, m_FAST%Lin%LinTimes, p%NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) else CALL ReadCom( UnIn, InputFile, 'Times to linearize (s) [1 to NLinTimes] ', ErrStat2, ErrMsg2, UnEc ) end if CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} @@ -2818,15 +2801,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if - ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}: - CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation)", ErrStat2, ErrMsg2, UnEc) + ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes}: + CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation; 3=mode shapes)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() RETURN end if - IF ( p%WrVTK < 0 .OR. p%WrVTK > 2 ) THEN + IF ( p%WrVTK < 0 .OR. p%WrVTK > 3 ) THEN p%WrVTK = VTK_Unknown END IF @@ -2867,7 +2850,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if ! VTK_fps - Frame rate for VTK output (frames per second) {will use closest integer multiple of DT} - CALL ReadVar( UnIn, InputFile, VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, p%VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2876,24 +2859,26 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err ! convert frames-per-second to seconds per sample: - if ( EqualRealNos(VTK_fps, 0.0_DbKi) ) then + if ( EqualRealNos(p%VTK_fps, 0.0_DbKi) ) then TmpTime = p%TMax + p%DT else - TmpTime = 1.0_DbKi / VTK_fps + TmpTime = 1.0_DbKi / p%VTK_fps end if ! now save the number of time steps between VTK file output: - IF (TmpTime > p%TMax) THEN + IF (p%WrVTK == VTK_ModeShapes) THEN + p%n_VTKTime = 1 + ELSE IF (TmpTime > p%TMax) THEN p%n_VTKTime = HUGE(p%n_VTKTime) - ELSE + ELSE p%n_VTKTime = NINT( TmpTime / p%DT ) ! I'll warn if p%n_VTKTime*p%DT is not TmpTime - IF (p%WrVTK > VTK_None) THEN + IF (p%WrVTK == VTK_Animate) THEN TmpRate = p%n_VTKTime*p%DT if (.not. EqualRealNos(TmpRate, TmpTime)) then call SetErrStat(ErrID_Info, '1/VTK_fps is not an integer multiple of DT. FAST will output VTK information at '//& trim(num2lstr(1.0_DbKi/TmpRate))//' fps, the closest rate possible.',ErrStat,ErrMsg,RoutineName) - end if + end if END IF END IF @@ -2910,38 +2895,6 @@ end subroutine cleanup !............................................................................................................................... END SUBROUTINE FAST_ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- -!> This function builds the path for the vtk directory based on the output file root -FUNCTION get_vtkdir_path( out_file_root ) - CHARACTER(1024) :: get_vtkdir_path - CHARACTER(*), INTENT(IN) :: out_file_root - INTEGER(IntKi) :: last_separator_index - - ! get the directory of the primary input file (i.e. the case directory); Windows can have either forward or backward slashes (compare with GetPath()) - - last_separator_index = index(out_file_root, '/', back=.true.) - last_separator_index = max( index(out_file_root, '\', back=.true.), last_separator_index ) - - if (last_separator_index==0) then - get_vtkdir_path = '.'//PathSep//'vtk' - else - get_vtkdir_path = trim(out_file_root(1 : last_separator_index) // 'vtk') - end if -END FUNCTION -!---------------------------------------------------------------------------------------------------------------------------------- -!> This function builds the path for the vtk root file name based on the output file root -FUNCTION get_vtkroot_path( out_file_root ) - CHARACTER(1024) :: get_vtkroot_path - CHARACTER(*), INTENT(IN) :: out_file_root - INTEGER(IntKi) :: last_separator_index - INTEGER(IntKi) :: path_length - - last_separator_index = index(out_file_root, '/', back=.true.) - last_separator_index = max( index(out_file_root, '\', back=.true.), last_separator_index ) - - get_vtkroot_path = trim( get_vtkdir_path(out_file_root) ) // PathSep & - // out_file_root( last_separator_index + 1 :) -END FUNCTION -!---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up some of the information needed for plotting VTK surfaces. It initializes only the data needed before !! HD initialization. (HD needs some of this data so it can return the wave elevation data we want.) SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat, ErrMsg) @@ -2971,7 +2924,8 @@ SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrS else BladeLength = InitOutData_ED%BladeLength end if - p_FAST%VTK_Surface%GroundRad = BladeLength + InitOutData_ED%HubRad + p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad + p_FAST%VTK_Surface%GroundRad = BladeLength + p_FAST%VTK_Surface%HubRad !........................................................................................................ ! We don't use the rest of this routine for stick-figure output @@ -3026,39 +2980,59 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H REAL(SiKi) :: x, y REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength INTEGER(IntKi) :: topNode, baseNode - INTEGER(IntKi) :: tipNode, rootNode, cylNode INTEGER(IntKi) :: NumBl, k - CHARACTER(1024) :: VTK_path + CHARACTER(1024) :: vtkroot INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' - + + ErrStat = ErrID_None ErrMsg = "" + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and ! create the VTK directory if it does not exist - call MKDIR( get_vtkdir_path(p_FAST%OutFileRoot) ) + + call GetPath ( p_FAST%OutFileRoot, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // 'vtk' + + call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) + + p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + if (p_FAST%WrVTK == VTK_ModeShapes .AND. p_FAST%VTK_modes%VTKLinTim==1) then + if (p_FAST%NLinTimes < 1) p_FAST%NLinTimes = 1 !in case we reached here with an error + p_FAST%VTK_tWidth = CEILING( log10( real( p_FAST%NLinTimes) ) ) + 1 + else + p_FAST%VTK_tWidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 + end if + + ! determine number of blades + NumBl = InitOutData_ED%NumBl ! initialize the vtk data - p_FAST%VTK_Surface%NumSectors = 18 - p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad - ! NOTE: we set p_FAST%VTK_Surface%GroundRad in SetVTKParameters_B4HD + p_FAST%VTK_Surface%NumSectors = 25 + ! NOTE: we set p_FAST%VTK_Surface%GroundRad and p_FAST%VTK_Surface%HubRad in SetVTKParameters_B4HD + + ! write the ground or seabed reference polygon: - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) RefPoint = p_FAST%TurbinePos if (p_FAST%CompHydro == MODULE_HD) then RefLengths = p_FAST%VTK_Surface%GroundRad*VTK_GroundFactor/2.0_SiKi ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%WtrDpth - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.SeabedSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.SeabedSurface', ErrStat2, ErrMsg2 ) RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%MSL2SWL - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) else RefLengths = p_FAST%VTK_Surface%GroundRad !array = scalar - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.GroundSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', ErrStat2, ErrMsg2 ) end if @@ -3068,8 +3042,9 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H !........................................................................................................ ! we're going to create a box using these dimensions - y = ED%Output(1)%HubPtMotion%Position(3, 1) - ED%Output(1)%NacelleMotion%Position(3, 1) - x = TwoNorm( ED%Output(1)%HubPtMotion%Position(1:2,1) - ED%Output(1)%NacelleMotion%Position(1:2,1) ) - InitOutData_ED%HubRad + y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + p_FAST%VTK_Surface%NacelleBox(:,1) = (/ -x, y, 0.0_SiKi /) p_FAST%VTK_Surface%NacelleBox(:,2) = (/ x, y, 0.0_SiKi /) @@ -3084,27 +3059,28 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H ! tapered tower !....................... - CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%Output(1)%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN - - topNode = ED%Output(1)%TowerLn2Mesh%NNodes - 1 - baseNode = ED%Output(1)%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%Output(1)%TowerLn2Mesh%position(:,topNode) - ED%Output(1)%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower + + topNode = ED%y%TowerLn2Mesh%NNodes - 1 + baseNode = ED%y%TowerLn2Mesh%refNode + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower TwrDiam_top = 3.87*TwrRatio TwrDiam_base = 6.0*TwrRatio TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength - do k=1,ED%Output(1)%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%Output(1)%TowerLn2Mesh%position(:,k) - ED%Output(1)%TowerLn2Mesh%position(:,baseNode) ) + do k=1,ED%y%TowerLn2Mesh%NNodes + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength end do + + !....................... ! blade surfaces !....................... - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) allocate(p_FAST%VTK_Surface%BladeShape(NumBl),stat=ErrStat2) if (errStat2/=0) then call setErrStat(ErrID_Fatal,'Error allocating VTK_Surface%BladeShape.',ErrStat,ErrMsg,RoutineName) @@ -3153,11 +3129,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H END DO ELSE DO K=1,NumBl - rootNode = ED%Output(1)%BladeLn2Mesh(K)%NNodes - tipNode = ED%Output(1)%BladeLn2Mesh(K)%NNodes-1 - cylNode = min(2,ED%Output(1)%BladeLn2Mesh(K)%NNodes) + rootNode = ED%y%BladeLn2Mesh(K)%NNodes + tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 + cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) - call SetVTKDefaultBladeParams(ED%Output(1)%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, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO @@ -3179,6 +3155,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H p_FAST%VTK_Surface%WaveElevXY(:,k) = p_FAST%VTK_Surface%WaveElevXY(:,k) + p_FAST%TurbinePos(1:2) end do + ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines !do k=1,size(p_FAST%VTK_Surface%WaveElev,2) ! p_FAST%VTK_Surface%WaveElev(:,k) = p_FAST%VTK_Surface%WaveElev(:,k) + p_FAST%TurbinePos(3) ! not sure this is really accurate if p_FAST%TurbinePos(3) is non-zero !end do @@ -3648,10 +3625,10 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) WRITE (y_FAST%UnSum, Fmt ) y_FAST%Module_Ver(Module_Number)%Name, p_FAST%DT_module(Module_Number), p_FAST%n_substeps(Module_Number) END IF END DO - IF ( NINT( p_FAST%DT_out / p_FAST%DT ) == 1_IntKi ) THEN + IF ( p_FAST%n_DT_Out == 1_IntKi ) THEN WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, 1_IntKi ! we'll write "1" instead of "1^-1" ELSE - WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, NINT( p_FAST%DT_out / p_FAST%DT ),"^-1" + WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, p_FAST%n_DT_Out,"^-1" END IF IF (p_FAST%WrVTK == VTK_Animate) THEN @@ -3663,16 +3640,17 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) ELSE WRITE (y_FAST%UnSum, Fmt ) "VTK output files ", TmpRate, p_FAST%n_VTKTime,"^-1" END IF - + ELSE + TmpRate = p_FAST%VTK_fps + END IF + ! bjj: fix this; possibly add names of which files will be generated? - if (p_FAST%WrVTK == VTK_Animate) then - Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' + IF (p_FAST%WrVTK == VTK_Animate .or. p_FAST%WrVTK == VTK_ModeShapes) THEN + Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' - WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" - WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" - WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" - end if - + WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" + WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" + WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" END IF @@ -3763,6 +3741,8 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! local variables INTEGER(IntKi), PARAMETER :: n_t_global = -1 ! loop counter + INTEGER(IntKi), PARAMETER :: n_t_global_next = 0 ! loop counter + REAL(DbKi) :: t_initial ! next simulation time (t_global_next) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3774,8 +3754,11 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ErrStat = ErrID_None ErrMsg = "" + t_initial = m_FAST%t_global ! which is used in place of t_global_next + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, p_FAST) + IF (p_FAST%WrSttsTime) then - CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, t_initial, p_FAST%TMax, p_FAST%TDesc ) END IF @@ -3784,10 +3767,10 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! the initial ServoDyn and IfW/Lidar inputs from Simulink: IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - IF ( p_FAST%CompInflow == Module_IfW ) CALL IfW_SetExternalInputs( IfW%p, m_FAST, ED%Output(1), IfW%Input(1) ) + IF ( p_FAST%CompInflow == Module_IfW ) CALL IfW_SetExternalInputs( IfW%p, m_FAST, ED%y, IfW%Input(1) ) - CALL CalcOutputs_And_SolveForInputs( n_t_global, m_FAST%t_global, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3796,29 +3779,14 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(0, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! turn off VTK output when if (p_FAST%WrVTK == VTK_InitOnly) then ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) - IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(m_FAST%t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN - CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) - !unOut = -1 - !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !close( unOut ) - END IF - - y_FAST%VTK_count = y_FAST%VTK_count + 1 + call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -3882,6 +3850,7 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as ! order = SIZE(ED%Input) + DO j = 1, p_FAST%InterpOrder + 1 ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt !ED_OutputTimes(j) = t_initial - (j - 1) * dt @@ -3890,16 +3859,10 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A DO j = 2, p_FAST%InterpOrder + 1 CALL ED_CopyInput (ED%Input(1), ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyOutput (ED%Output(1), ED%Output(j), MESH_NEWCOPY, Errstat2, ErrMsg2) !BJJ: THIS IS REALLY ONLY NECESSARY FOR ED-HD COUPLING AT THE MOMENT - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO CALL ED_CopyInput (ED%Input(1), ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOutput (ED%Output(1), ED%y, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Initialize predicted states for j_pc loop: CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4351,10 +4314,15 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! local variables REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed + LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed INTEGER(IntKi) :: I, k ! generic loop counters + + !REAL(ReKi) :: ControlInputGuess ! value of controller inputs INTEGER(IntKi) :: ErrStat2 @@ -4365,8 +4333,11 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ErrStat = ErrID_None ErrMsg = "" - t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - + n_t_global_next = n_t_global+1 + t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + !! determine if the Jacobian should be calculated this time IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian @@ -4400,13 +4371,16 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! !! gives predicted values at t+dt !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !! predictor-corrector loop: - DO j_pc = 0, NumCorrections + j_pc = 0 + do while (j_pc <= NumCorrections) + WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) !! @@ -4414,24 +4388,44 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! STATE_PRED values contain values at t_global_next. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.c: Input-Output Solve !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + ! save predicted inputs for comparison with corrected value later + !IF (p_FAST%CheckHSSBrTrqC) THEN + ! ControlInputGuess = ED%Input(1)%HSSBrTrqC + !END IF + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 2: Correct (continue in loop) !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + j_pc = j_pc + 1 + + ! ! Check if the predicted inputs were significantly different than the corrected inputs + ! ! (values before and after CalcOutputs_And_SolveForInputs) + !if (j_pc > NumCorrections) then + ! + ! !if (p_FAST%CheckHSSBrTrqC) then + ! ! if ( abs(ControlInputGuess - ED%Input(1)%HSSBrTrqC) > 50.0_ReKi ) then ! I randomly picked 50 N-m + ! ! NumCorrections = min(p_FAST%NumCrctn + 1, MaxCorrections) + ! ! ! print *, 'correction:', t_global_next, NumCorrections + ! ! cycle + ! ! end if + ! !end if + ! + ! ! check pitch position input to structural code (not implemented, yet) + !end if + enddo ! j_pc !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -4627,7 +4621,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global+1, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4636,8 +4630,9 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global + 1, p_FAST%n_SttsTime ) == 0 ) THEN - CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + IF ( MOD( n_t_global_next, p_FAST%n_SttsTime ) == 0 ) THEN + CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + ENDIF ENDIF @@ -4645,8 +4640,24 @@ END SUBROUTINE FAST_Solution !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine determines if it's time to write to the output files, and calls the routine to write to the files -!! with the output data. It should be called after all the output solves for a given time have been completed. +FUNCTION NeedWriteOutput(n_t_global, t_global, p_FAST) + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + + LOGICAL :: NeedWriteOutput !< Function result; if true, WriteOutput values are needed on this time step + + IF ( t_global >= p_FAST%TStart ) THEN ! note that if TStart isn't an multiple of DT_out, we will not necessarially start output to the file at TStart + NeedWriteOutput = MOD( n_t_global, p_FAST%n_DT_Out ) == 0 + ELSE + NeedWriteOutput = .FALSE. + END IF + +END FUNCTION NeedWriteOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine determines if it's time to write to the output files--based on a previous call to fast_subs::needwriteoutput--, and +!! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time +!! have been completed, and assumes y_FAST\%WriteThisStep has been set. SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... @@ -4677,9 +4688,6 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(DbKi) :: OutTime ! Used to determine if output should be generated at this simulation time - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WriteOutputToFile' ErrStat = ErrID_None @@ -4687,43 +4695,26 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, ! Write time-series channel data - IF ( t_global >= p_FAST%TStart ) THEN - - !bjj FIX THIS algorithm!!! this assumes dt_out is an integer multiple of dt; we will probably have to do some interpolation to get these outputs at the times we want them.... - !bjj: perhaps we should do this with integer math on n_t_global now... - OutTime = NINT( t_global / p_FAST%DT_out ) * p_FAST%DT_out - IF ( EqualRealNos( t_global, OutTime ) ) THEN + !y_FAST%WriteThisStep = NeedWriteOutput(n_t_global, t_global, p_FAST) + IF ( y_FAST%WriteThisStep ) THEN - ! Generate glue-code output file + ! Generate glue-code output file - CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%Output(1)%WriteOutput, & - AD%y%WriteOutput, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & - FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) - - END IF + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%y%WriteOutput, & + AD%y%WriteOutput, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & + FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) ENDIF ! Write visualization data (and also note that we're ignoring any errors that occur doing so) IF ( p_FAST%WrVTK == VTK_Animate ) THEN IF ( MOD( n_t_global, p_FAST%n_VTKTime ) == 0 ) THEN - - IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN - CALL WriteMotionMeshesToFile(t_global, ED%Output(1), SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') - END IF - - y_FAST%VTK_count = y_FAST%VTK_count + 1 + call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) END IF END IF -END SUBROUTINE WriteOutputToFile +END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, ADOutput, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput,& @@ -4826,7 +4817,7 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%OpFM%y%WriteOutput, & - Turbine%ED%Output(1)%WriteOutput, Turbine%AD%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & + Turbine%ED%y%WriteOutput, Turbine%AD%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & Turbine%FEAM%y%WriteOutput, Turbine%MD%y%WriteOutput, Turbine%Orca%y%WriteOutput, & Turbine%IceF%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) @@ -4953,8 +4944,57 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, ADOutp END SUBROUTINE FillOutputAry !---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WriteVTK' + + + IF ( p_FAST%VTK_Type == VTK_Surf ) THEN + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN + CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) + CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') + !unOut = -1 + !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !close( unOut ) + END IF + + y_FAST%VTK_count = y_FAST%VTK_count + 1 + +END SUBROUTINE WriteVTK +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes all the committed meshes to VTK-formatted files. It doesn't bother with returning an error code. -SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + use FVW_IO, only: WrVTK_FVW TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code @@ -4963,7 +5003,6 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -4979,54 +5018,45 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O logical :: outputFields ! flag to determine if we want to output the HD mesh fields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_AllMeshes' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif + NumBl = 0 - if (allocated(ED%Output)) then - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) - end if + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) + ! I'm first going to just put all of the meshes that get mapped together, then decide if we're going to print/plot them all ! ElastoDyn - if (allocated(ED%Output) .and. allocated(ED%Input)) then + if (allocated(ED%Input)) then ! ElastoDyn outputs (motions) DO K=1,NumBl !%BladeLn2Mesh(K) used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeRootMotion(K), trim(VTK_path)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! these will get output with their sibling input meshes - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(p_FAST%OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(p_FAST%OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ElastoDyn inputs (loads) ! %BladePtLoads used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(VTK_path)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%TowerLn2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(VTK_path)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%HubPtMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(VTK_path)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%NacelleMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(VTK_path)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%PlatformPtMesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TowerLn2Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%HubPtMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%NacelleMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%PlatformPtMesh ) end if @@ -5035,51 +5065,51 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O do K=1,NumBl ! BeamDyn inputs - !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(VTK_path)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end do if (allocated(MeshMapData%y_BD_BldMotion_4Loads)) then do K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(VTK_path)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) ! skipping PointLoad end do elseif (p_FAST%BD_OutputSibling) then do K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, BD%y(k)%BldMotion ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%y(k)%BldMotion ) ! skipping PointLoad end do end if do K=1,NumBl ! BeamDyn outputs - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, BD%Input(1,k)%RootMotion ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%VTK_OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%Input(1,k)%RootMotion ) end do if (.not. p_FAST%BD_OutputSibling) then !otherwise this mesh has been put with the DistrLoad mesh do K=1,NumBl ! BeamDyn outputs - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end do end if - ELSE if (allocated(ED%Input) .and. allocated(ED%Output)) then + ELSE if (p_FAST%CompElast == Module_ED .and. allocated(ED%Input)) then ! ElastoDyn DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(VTK_path)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%BladeLn2Mesh(K) ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%BladeLn2Mesh(K) ) END DO END IF ! ServoDyn if (allocated(SrvD%Input)) then IF ( SrvD%Input(1)%NTMD%Mesh%Committed ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%NTMD%Mesh, trim(p_FAST%OutFileRoot)//'.SrvD_NTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NTMD%Mesh, trim(VTK_path)//'.SrvD_NTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SrvD%Input(1)%TTMD%Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%NTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TTMD%Mesh ) END IF IF ( SrvD%Input(1)%TTMD%Mesh%Committed ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%TTMD%Mesh, trim(p_FAST%OutFileRoot)//'.SrvD_TTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TTMD%Mesh, trim(VTK_path)//'.SrvD_TTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SrvD%Input(1)%TTMD%Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%TTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TTMD%Mesh ) END IF end if @@ -5090,77 +5120,89 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O if (allocated(AD%Input(1)%BladeRootMotion)) then DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeRootMotion(K), trim(VTK_path)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(VTK_path)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(VTK_path)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, AD%Input(1)%BladeMotion(k) ) + call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%BladeMotion(k) ) END DO - call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(VTK_path)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, AD%Input(1)%TowerMotion ) + call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%TowerMotion ) end if - + + ! FVW submodule of AD15 + if (allocated(AD%m%FVW_u)) then + if (allocated(AD%m%FVW_u(1)%WingsMesh)) then + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%m%FVW_u(1)%WingsMesh(k), trim(p_FAST%VTK_OutFileRoot)//'.FVW_WingsMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%BladeMotion(k) ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + END DO + ! Free wake + call WrVTK_FVW(AD%p%FVW, AD%x(1)%FVW, AD%z(1)%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', y_FAST%VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + end if + end if END IF ! HydroDyn IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Mesh, trim(p_FAST%OutFileRoot)//'.HD_Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%LumpedMesh, trim(p_FAST%OutFileRoot)//'.HD_MorisonLumped_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%OutFileRoot)//'.HD_MorisonDistrib_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%LumpedMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonLumped_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) if (p_FAST%CompSub == Module_NONE) then - call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(VTK_path)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(p_FAST%VTK_OutFileRoot)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = .false. else - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Mesh, trim(VTK_path)//'.HD_Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = p_FAST%VTK_fields end if - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%LumpedMesh, trim(VTK_path)//'.HD_MorisonLumped', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Morison%LumpedMesh ) - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%DistribMesh, trim(VTK_path)//'.HD_MorisonDistrib', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Morison%DistribMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%LumpedMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonLumped', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%LumpedMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%DistribMesh ) END IF ! SubDyn IF ( p_FAST%CompSub == Module_SD .and. allocated(SD%Input)) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(VTK_path)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SD%y%y2Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%y%y2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(VTK_path)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SD%Input(1)%TPMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%Input(1)%TPMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm .and. allocated(ExtPtfm%Input)) THEN - call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(VTK_path)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ExtPtfm%Input(1)%PtfmMesh ) + call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ExtPtfm%Input(1)%PtfmMesh ) END IF ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN if (allocated(MAPp%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(VTK_path)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MAPp%Input(1)%PtFairDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MAPp%Input(1)%PtFairDisplacement ) + !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 ) end if ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if (allocated(MD%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(VTK_path)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MD%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + 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 ) end if ! FEAMooring ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN if (allocated(FEAM%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(VTK_path)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, FEAM%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, FEAM%Input(1)%PtFairleadDisplacement ) + !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 ! Orca ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN if (allocated(Orca%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(VTK_path)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Orca%Input(1)%PtfmMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Orca%Input(1)%PtfmMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if END IF @@ -5168,8 +5210,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O ! IceFloe IF ( p_FAST%CompIce == Module_IceF ) THEN if (allocated(IceF%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(VTK_path)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, IceF%Input(1)%iceMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceF%Input(1)%iceMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! IceDyn @@ -5177,8 +5219,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O if (allocated(IceD%Input)) then DO k = 1,p_FAST%numIceLegs - call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(VTK_path)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, IceD%Input(1,k)%PointMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceD%Input(1,k)%PointMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO end if @@ -5189,7 +5231,7 @@ END SUBROUTINE WrVTK_AllMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes (enough to visualize the turbine) to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code @@ -5198,7 +5240,6 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5212,87 +5253,77 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop logical :: OutputFields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_BasicMeshes' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - + NumBl = 0 - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - -! Nacelle - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(VTK_path)//'.ED_Nacelle', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=ED%Input(1)%NacelleLoads ) - -! Hub - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(VTK_path)//'.ED_Hub', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=ED%Input(1)%HubPtLoad ) ! Blades IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(VTK_path)//'.AD_Blade'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=AD%y%BladeLoad(K) ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%BladeLoad(K) ) END DO ELSE IF ( p_FAST%CompElast == Module_BD ) THEN DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(VTK_path)//'.BD_BldMotion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - ELSE + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO END IF - + +! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%NacelleLoads ) + +! Hub + call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%HubPtLoad ) ! Tower motions - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.ED_TowerLn2Mesh_motion', & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + ! Substructure -! call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF IF ( p_FAST%CompHydro == Module_HD ) THEN if (p_FAST%CompSub == Module_NONE) then - call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(VTK_path)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(p_FAST%VTK_OutFileRoot)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = .false. else OutputFields = p_FAST%VTK_fields end if - call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(VTK_path)//'.HD_MorisonDistrib', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, Sib=HD%y%Morison%DistribMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=HD%y%Morison%DistribMesh ) END IF ! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! 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%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! 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 ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! 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 @@ -5300,7 +5331,8 @@ END SUBROUTINE WrVTK_BasicMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + use FVW_IO, only: WrVTK_FVW REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -5310,7 +5342,6 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5325,76 +5356,71 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - NumBl = 0 - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - ! Ground (written at initialization) ! Wave elevation if ( allocated( p_FAST%VTK_Surface%WaveElev ) ) call WrVTK_WaveElev( t_global, p_FAST, y_FAST, HD) - ! Nacelle - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(VTK_path)//'.NacelleSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.NacelleSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) ! Hub - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(VTK_path)//'.HubSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , & + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.HubSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & NumSegments=p_FAST%VTK_Surface%NumSectors, radius=p_FAST%VTK_Surface%HubRad, Sib=ED%Input(1)%HubPtLoad ) +! Tower motions + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + ! Blades IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & ,Sib=AD%y%BladeLoad(k) ) END DO ELSE IF ( p_FAST%CompElast == Module_BD ) THEN DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO - ELSE + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO END IF - -! Tower motions - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.TowerSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + +! Free wake + if (allocated(AD%m%FVW_u)) then + if (allocated(AD%m%FVW_u(1)%WingsMesh)) then + call WrVTK_FVW(AD%p%FVW, AD%x(1)%FVW, AD%z(1)%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', y_FAST%VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + end if + end if + ! Platform -! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) +! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) ! Substructure -! call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF IF ( HD%Input(1)%Morison%DistribMesh%Committed ) THEN @@ -5404,24 +5430,24 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A ! OutputFields = p_FAST%VTK_fields !end if - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(VTK_path)//'.MorisonSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, p_FAST%VTK_Surface%NumSectors, & + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.MorisonSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, & p_FAST%VTK_Surface%MorisonRad, Sib=HD%y%Morison%DistribMesh ) END IF ! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! 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%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, 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%OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! 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 if (p_FAST%VTK_fields) then - call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -5444,8 +5470,7 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) INTEGER(IntKi) :: NumberOfPoints INTEGER(IntKi), parameter :: NumberOfLines = 0 INTEGER(IntKi) :: NumberOfPolys - INTEGER(IntKi) :: Twidth - CHARACTER(1024) :: VTK_path, Tstr = '' + CHARACTER(1024) :: Tstr INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElev' @@ -5459,21 +5484,11 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) !................................................................. ! write the data that potentially changes each time step: !................................................................. - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - ! construct the string for the zero-padded VTK write-out step - write(Tstr(1 : Twidth), '(i' // trim(Num2LStr(Twidth)) //'.'// trim(Num2LStr(Twidth)) // ')') y_FAST%VTK_count + write(Tstr, '(i' // trim(Num2LStr(p_FAST%VTK_tWidth)) //'.'// trim(Num2LStr(p_FAST%VTK_tWidth)) // ')') y_FAST%VTK_count ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file - FileName = TRIM(VTK_path)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' + FileName = TRIM(p_FAST%VTK_OutFileRoot)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat2, ErrMsg2 ) if (ErrStat2 >= AbortErrLev) return @@ -5747,7 +5762,7 @@ SUBROUTINE FAST_Linearize_Tary(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) ! local variables INTEGER(IntKi) :: i_turb, NumTurbines INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_Tary' @@ -5779,10 +5794,10 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) ! local variables REAL(DbKi) :: t_global ! current simulation time REAL(DbKi) :: next_lin_time ! next simulation time where linearization analysis should be performed + INTEGER(IntKi) :: iLinTime ! loop counter INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message - CHARACTER(MaxWrScrLen) :: BlankLine - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' ErrStat = ErrID_None @@ -5790,34 +5805,82 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( .not. Turbine%p_FAST%Linearize ) return - if (Turbine%m_FAST%NextLinTimeIndx <= size(Turbine%p_FAST%LinTimes) ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? + if (.not. Turbine%p_FAST%CalcSteady) then + + if ( Turbine%m_FAST%Lin%NextLinTimeIndx <= Turbine%p_FAST%NLinTimes ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? - next_lin_time = Turbine%p_FAST%LinTimes( Turbine%m_FAST%NextLinTimeIndx ) - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + next_lin_time = Turbine%m_FAST%Lin%LinTimes( Turbine%m_FAST%Lin%NextLinTimeIndx ) + t_global = t_initial + n_t_global*Turbine%p_FAST%dt - if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then - - BlankLine = "" - CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces - CALL WrOver ( ' Performing linearization at simulation time '//TRIM( Num2LStr(t_global) )//' s. (RotSpeed='& - //trim(num2lstr(Turbine%ED%Output(1)%RotSpeed*RPS2RPM))//' rpm, BldPitch1='//trim(num2lstr(Turbine%ED%Output(1)%BlPitch(1)*R2D))//' deg)' ) - CALL WrScr('') + if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then + if (Turbine%m_FAST%Lin%NextLinTimeIndx > Turbine%p_FAST%NLinTimes) call WrVTKCheckpoint() + end if + + end if + end if + + else ! CalcSteady - CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + + call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%m_FAST%Lin%FoundSteady) then + + do iLinTime=1,Turbine%p_FAST%NLinTimes + t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) + + call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Turbine%m_FAST%NextLinTimeIndx = Turbine%m_FAST%NextLinTimeIndx + 1 + if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then + Turbine%m_FAST%calcJacobian = .true. + Turbine%m_FAST%NextJacCalcTime = t_global + end if + + CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & + Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + end do + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) CALL WrVTKCheckpoint() end if end if + return - +contains + subroutine WrVTKCheckpoint() + ! we are creating a checkpoint file for each turbine, so setting NumTurbines=1 in the file + CALL FAST_CreateCheckpoint_T(t_initial, Turbine%p_FAST%n_TMax_m1+1, 1, Turbine, TRIM(Turbine%p_FAST%OutFileRoot)//'.ModeShapeVTK', ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine WrVTKCheckpoint END SUBROUTINE FAST_Linearize_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -5827,12 +5890,21 @@ END SUBROUTINE FAST_Linearize_T !> Routine that calls ExitThisProgram for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. !! This routine should be called from glue code only (e.g., FAST_Prog.f90). It should not be called in any of these driver routines. -SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg ) +SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< Data for one turbine instance INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats + + LOGICAL :: SkipRunTimes + + IF (PRESENT(SkipRunTimeMsg)) THEN + SkipRunTimes = SkipRunTimeMsg + ELSE + SkipRunTimes = .FALSE. + END IF IF (PRESENT(ErrLocMsg)) THEN @@ -5840,14 +5912,14 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg ) CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) ELSE CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) END IF @@ -5858,7 +5930,7 @@ END SUBROUTINE ExitThisProgram_T !! This routine should not be called from glue code (e.g., FAST_Prog.f90) or ExitThisProgram_T only. It should not be called in any !! of these driver routines. SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) !............................................................................................................................... ! Passed arguments @@ -5888,28 +5960,27 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats ! Local variables: INTEGER(IntKi) :: ErrorLevel + LOGICAL :: PrintRunTimes INTEGER(IntKi) :: ErrStat2 ! Error status - CHARACTER(1024) :: ErrMsg2 ! Error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message CHARACTER(1224) :: SimMsg ! optional message to print about where the error took place in the simulation CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' - CHARACTER( LEN(p_FAST%OutFileRoot) ) :: TmpOutFileRoot ErrorLevel = ErrLevel_in ! for debugging, let's output the meshes and all of their fields IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None) THEN - TmpOutFileRoot = p_FAST%OutFileRoot - p_FAST%OutFileRoot = trim(p_FAST%OutFileRoot)//'.DebugError' + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - p_FAST%OutFileRoot = TmpOutFileRoot + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -5940,6 +6011,12 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ELSE SimMsg = 'after the simulation completed' END IF + + IF (y_FAST%UnSum > 0) THEN + CLOSE(y_FAST%UnSum) + y_FAST%UnSum = -1 + END IF + SimMsg = 'FAST encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) if (StopTheProgram) then @@ -5953,11 +6030,19 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, !............................................................................................................................ ! Write simulation times and stop !............................................................................................................................ - - IF (p_FAST%WrSttsTime) THEN - CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, DescStrIn=p_FAST%TDesc ) - END IF + if (present(SkipRunTimeMsg)) then + PrintRunTimes = .not. SkipRunTimeMsg + else + PrintRunTimes = .true. + end if + IF (p_FAST%WrSttsTime .and. PrintRunTimes) THEN + CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, UnSum=y_FAST%UnSum, DescStrIn=p_FAST%TDesc ) + END IF + IF (y_FAST%UnSum > 0) THEN + CLOSE(y_FAST%UnSum) + y_FAST%UnSum = -1 + END IF if (StopTheProgram) then #if (defined COMPILE_SIMULINK || defined COMPILE_LABVIEW) @@ -5973,10 +6058,11 @@ END SUBROUTINE ExitThisProgram !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is called at program termination. It writes any additional output files, !! deallocates variables for FAST file I/O and closes files. -SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, ErrStat, ErrMsg ) +SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< FAST Parameters TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< FAST Output + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables (only for the final time) INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Message associated with errro status @@ -6078,12 +6164,12 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD ErrMsg = "" - CALL FAST_EndOutput( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2 ) + ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF @@ -6319,7 +6405,7 @@ SUBROUTINE FAST_CreateCheckpoint_Tary(t_initial, n_t_global, Turbine, Checkpoint INTEGER(IntKi) :: i_turb INTEGER :: Unit INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CreateCheckpoint_Tary' @@ -6350,6 +6436,7 @@ END SUBROUTINE FAST_CreateCheckpoint_Tary SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_CHECKPOINT REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -6370,7 +6457,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, INTEGER(IntKi) :: unOut ! unit number for output file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CreateCheckpoint_T' CHARACTER(1024) :: FileName ! Name of the (output) checkpoint file @@ -6456,18 +6543,20 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! store value to be overwritten old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) - FileName = Turbine%SrvD%p%DLL_InFile + FileName = Turbine%SrvD%m%dll_data%DLL_InFile ! overwrite values: - Turbine%SrvD%p%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = -8 - CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p%DLL_Trgt, Turbine%SrvD%m%dll_data, Turbine%SrvD%p, ErrStat2, ErrMsg2) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_CHECKPOINT + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! put values back: - Turbine%SrvD%p%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%DLL_InFile = FileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if END IF @@ -6498,7 +6587,7 @@ SUBROUTINE FAST_RestoreFromCheckpoint_Tary(t_initial, n_t_global, Turbine, Check INTEGER(IntKi) :: i_turb INTEGER :: Unit INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreFromCheckpoint_Tary' @@ -6529,6 +6618,7 @@ END SUBROUTINE FAST_RestoreFromCheckpoint_Tary !! the turbine instance. SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_RESTARTING REAL(DbKi), INTENT(INOUT) :: t_initial !< initial time INTEGER(IntKi), INTENT(INOUT) :: n_t_global !< loop counter @@ -6549,7 +6639,7 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb INTEGER(IntKi) :: unIn ! unit number for input file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreFromCheckpoint_T' CHARACTER(1024) :: FileName ! Name of the (input) checkpoint file @@ -6654,17 +6744,19 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE ! store value to be overwritten old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) - FileName = Turbine%SrvD%p%DLL_InFile + FileName = Turbine%SrvD%m%dll_data%DLL_InFile ! overwrite values before calling DLL: - Turbine%SrvD%p%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = -9 - CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p%DLL_Trgt, Turbine%SrvD%m%dll_data, Turbine%SrvD%p, ErrStat2, ErrMsg2) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_RESTARTING + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! put values back: - Turbine%SrvD%p%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%DLL_InFile = FileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if end if @@ -6685,4 +6777,504 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb END SUBROUTINE FAST_RestoreFromCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_RestoreForVTKModeShape_T for an array of Turbine data structures. +SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time (for comparing with time from checkpoint file) + TYPE(FAST_TurbineType), INTENT( OUT) :: Turbine(:) !< all data for one instance of a turbine + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + 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_turb + INTEGER(IntKi) :: n_t_global !< loop counter + INTEGER(IntKi) :: NumTurbines ! Number of turbines in this simulation + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_Tary' + + + ErrStat = ErrID_None + ErrMsg = "" + + NumTurbines = SIZE(Turbine) + if (NumTurbines /=1) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization is not available for multiple turbines.", ErrStat, ErrMsg, RoutineName) + return + end if + + + CALL ReadModeShapeFile( Turbine(1)%p_FAST, trim(InputFileName), ErrStat2, ErrMsg2, checkpointOnly=.true. ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + CALL FAST_RestoreFromCheckpoint_Tary( t_initial, n_t_global, Turbine, trim(Turbine(1)%p_FAST%VTK_modes%CheckpointRoot), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + DO i_turb = 1,NumTurbines + if (.not. allocated(Turbine(i_turb)%m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization requires a checkpoint file from a simulation with linearization analysis, but NLinTimes is 0.", ErrStat, ErrMsg, RoutineName) + return + end if + + CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & + Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%OpFM, & + Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + +END SUBROUTINE FAST_RestoreForVTKModeShape_Tary + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calculates the motions generated by mode shapes and outputs VTK data for it +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: dt ! time + REAL(DbKi) :: tprime ! time + INTEGER(IntKi) :: nt + + INTEGER(IntKi) :: iLinTime ! generic loop counters + INTEGER(IntKi) :: it ! generic loop counters + INTEGER(IntKi) :: iMode ! generic loop counters + INTEGER(IntKi) :: ModeNo ! mode number + INTEGER(IntKi) :: NLinTimes + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_T' + CHARACTER(1024) :: VTK_RootName + + + ErrStat = ErrID_None + ErrMsg = "" + + CALL ReadModeShapeFile( p_FAST, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + call ReadModeShapeMatlabFile( p_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) return + + y_FAST%WriteThisStep = .true. + y_FAST%UnSum = -1 + + NLinTimes = min( p_FAST%VTK_modes%VTKNLinTimes, size(p_FAST%VTK_modes%x_eig_magnitude,2), p_FAST%NLinTimes ) + + 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 + + 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 + tprime = m_FAST%Lin%LinTimes(iLinTime) - m_FAST%Lin%LinTimes(1) + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + 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 + + do iLinTime = 1,NLinTimes + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo))//'.LinTime'//trim(num2lstr(iLinTime)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + do it = 1,nt + tprime = (it-1)*dt + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do + + + end do ! iLinTime + end do ! iMode + + end select + +END SUBROUTINE FAST_RestoreForVTKModeShape_T +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, nt, dt, VTK_tWidth ) + REAL(R8Ki), INTENT(IN ) :: DampedFreq_Hz + REAL(DbKi), INTENT(IN ) :: VTK_fps + INTEGER(IntKi), INTENT( OUT) :: nt !< number of steps + REAL(DbKi), INTENT( OUT) :: dt !< time step + INTEGER(IntKi), INTENT( OUT) :: VTK_tWidth + + REAL(DbKi) :: cycle_time ! time for one cycle of mode + INTEGER(IntKi) :: NCycles + INTEGER(IntKi), PARAMETER :: MinFrames = 5 + + if (DampedFreq_Hz <= 0.0_DbKi) then + nt = huge(nt) + dt = epsilon(dt) + VTK_tWidth = 1 + return + end if + + nt = 1 + NCycles = 0 + do while (nt= AbortErrLev) RETURN + + ! Process the requested data records of this file. + + CALL WrScr ( NewLine//' =======================================================' ) + CALL WrScr ( ' Reading in data from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".'//NewLine ) + + + ! Read some of the header information. + + READ (UnIn, IOSTAT=ErrStat2) FileType ! placeholder for future file format changes + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading FileType from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nModes ! number of modes in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nModes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nStates ! number of states in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nStates from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) NLinTimes ! number of linearization times / azimuths in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NLinTimes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ALLOCATE( p_FAST%VTK_Modes%NaturalFreq_Hz(nModes), & + p_FAST%VTK_Modes%DampingRatio( nModes), & + p_FAST%VTK_Modes%DampedFreq_Hz( nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%NaturalFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NaturalFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampingRatio ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampingRatio array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampedFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampedFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + if (nModes < p_FAST%VTK_Modes%VTKLinModes) CALL SetErrStat(ErrID_Severe,'Number of modes requested exceeds the number of modes in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + if (NLinTimes /= p_FAST%NLinTimes) CALL SetErrStat(ErrID_Severe,'Number of times linearization was performed is not the same as the number of linearization times in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + + + !Let's read only the number of modes we need to use + nModes = min( nModes, p_FAST%VTK_Modes%VTKLinModes ) + + ALLOCATE( p_FAST%VTK_Modes%x_eig_magnitude(nStates, NLinTimes, nModes), & + p_FAST%VTK_Modes%x_eig_phase( nStates, NLinTimes, nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + do iMode = 1,nModes + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_magnitude(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_magnitude from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_phase(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_phase from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + end do + +END SUBROUTINE ReadModeShapeMatlabFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + CHARACTER(*), INTENT(IN ) :: InputFile !< Name of the text input file to read + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: checkpointOnly !< Whether to return after reading checkpoint file name + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ReadModeShapeFile' + + CHARACTER(1024) :: PriPath ! Path name of the primary file + INTEGER(IntKi) :: i + INTEGER(IntKi) :: UnIn + INTEGER(IntKi) :: UnEc + LOGICAL :: VTKLinTimes1 + + ErrStat = ErrID_None + ErrMsg = "" + UnEc = -1 + + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + ! Open data file. + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) + + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + + CALL ReadCom( UnIn, InputFile, 'File header: (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadCom( UnIn, InputFile, 'File header: (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !----------- FILE NAMES ---------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: File Names', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%CheckpointRoot, 'CheckpointRoot', 'Name of the checkpoint file written by FAST when linearization data was produced', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF ( PathIsRelative( p_FAST%VTK_modes%CheckpointRoot ) ) p_FAST%VTK_modes%CheckpointRoot = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%CheckpointRoot) + + if (present(checkpointOnly)) then + if (checkpointOnly) then + call cleanup() + return + end if + end if + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%MatlabFileName, 'MatlabFileName', 'Name of the file with eigenvectors written by Matlab', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + IF ( PathIsRelative( p_FAST%VTK_modes%MatlabFileName ) ) p_FAST%VTK_modes%MatlabFileName = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%MatlabFileName) + + !----------- VISUALIZATION OPTIONS ------------------------------------------ + + CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization Options', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinModes, 'VTKLinModes', 'Number of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + if (p_FAST%VTK_modes%VTKLinModes <= 0) CALL SetErrStat( ErrID_Fatal, "VTKLinModes must be a positive number.", ErrStat, ErrMsg, RoutineName ) + + if (ErrStat >= AbortErrLev) then + CALL Cleanup() + RETURN + end if + + + call AllocAry( p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + + p_FAST%VTK_modes%VTKModes = -1 + + CALL ReadAry( UnIn, InputFile, p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', 'List of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + ! note that we don't check the ErrStat here; if the user entered fewer than p_FAST%VTK_modes%VTKLinModes values, we will use the + ! last entry to fill in remaining values. + !Check 1st value, we need at least one good value from user or throw error + IF (p_FAST%VTK_modes%VTKModes(1) < 0 ) THEN + call SetErrStat( ErrID_Fatal, "VTKModes must contain positive numbers.", ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + ELSE + DO i = 2, p_FAST%VTK_modes%VTKLinModes + IF ( p_FAST%VTK_modes%VTKModes(i) < 0 ) THEN + p_FAST%VTK_modes%VTKModes(i)=p_FAST%VTK_modes%VTKModes(i-1) + 1 + ENDIF + ENDDO + ENDIF + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinScale, 'VTKLinScale', 'Mode shape visualization scaling factor', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinTim, 'VTKLinTim', 'Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, VTKLinTimes1, 'VTKLinTimes1', 'If VTKLinTim=2, visualize modes at LinTimes(1) only?', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinPhase, 'VTKLinPhase', 'Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +! overwrite these based on inputs: + + if (p_FAST%VTK_modes%VTKLinTim == 2) then + p_FAST%VTK_modes%VTKLinPhase = 0 ! "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - + + if (VTKLinTimes1) then + p_FAST%VTK_modes%VTKNLinTimes = 1 + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + +contains + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE(UnIn) + END SUBROUTINE Cleanup + +END SUBROUTINE ReadModeShapeFile +!---------------------------------------------------------------------------------------------------------------------------------- END MODULE FAST_Subs +!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 9a34e11395..479e321315 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -49,6 +49,8 @@ MODULE FAST_Types USE UnsteadyAero_Types USE DBEMT_Types USE BEMT_Types +USE FVW_Types +USE AeroAcoustics_Types USE AeroDyn_Types USE SubDyn_Types USE Current_Types @@ -56,6 +58,7 @@ MODULE FAST_Types USE Waves2_Types USE Conv_Radiation_Types USE SS_Radiation_Types +USE SS_Excitation_Types USE WAMIT_Types USE WAMIT2_Types USE Morison_Types @@ -65,6 +68,7 @@ MODULE FAST_Types USE SuperController_Types USE IceDyn_Types USE FEAMooring_Types +USE MAP_Fortran_Types USE MAP_Types USE MoorDyn_Types USE OrcaFlexInterface_Types @@ -111,6 +115,23 @@ MODULE FAST_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonRad !< radius of each Morison node [m] END TYPE FAST_VTK_SurfaceType ! ======================= +! ========= FAST_VTK_ModeShapeType ======= + TYPE, PUBLIC :: FAST_VTK_ModeShapeType + CHARACTER(1024) :: CheckpointRoot !< name of the checkpoint file written by FAST when linearization data was produced [-] + CHARACTER(1024) :: MatlabFileName !< name of the file with eigenvectors written by Matlab [-] + INTEGER(IntKi) :: VTKLinModes !< Number of modes to visualize [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: VTKModes !< Which modes to visualize [-] + INTEGER(IntKi) :: VTKLinTim !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] + INTEGER(IntKi) :: VTKNLinTimes !< number of linearization times to use when VTKLinTim==2 [-] + REAL(ReKi) :: VTKLinScale !< Mode shape visualization scaling factor [-] + REAL(ReKi) :: VTKLinPhase !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampingRatio !< damping ratios from mbc3 analysis [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: NaturalFreq_Hz !< natural frequency from mbc3 analysis [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampedFreq_Hz !< damped frequency from mbc3 analysis [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_magnitude !< magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_phase !< phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] + END TYPE FAST_VTK_ModeShapeType +! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT !< Integration time step [global time] [s] @@ -152,13 +173,14 @@ MODULE FAST_Types LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] INTEGER(IntKi) :: n_SttsTime !< Number of time steps between screen status messages [-] INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] + INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] INTEGER(IntKi) :: TurbineType !< Type_LandBased, Type_Offshore_Fixed, or Type_Offshore_Floating [-] LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] INTEGER(IntKi) :: WrBinMod !< If writing binary, which file format is to be written [1, 2, or 3] [-] LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] - INTEGER(IntKi) :: WrVTK !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] + INTEGER(IntKi) :: WrVTK = 0 !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] INTEGER(IntKi) :: VTK_Type !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] LOGICAL :: VTK_fields !< Write mesh fields to VTK data files? (flag) {true/false} [-] CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] @@ -168,18 +190,98 @@ MODULE FAST_Types INTEGER(IntKi) :: TChanLen !< width of the time channel [-] CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] + CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] + INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] + REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] + TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] + CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] + LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimTol !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: Twr_Kdmp !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + REAL(ReKi) :: Bld_Kdmp !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + INTEGER(IntKi) :: NLinTimes !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] + REAL(DbKi) :: AzimDelta !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] INTEGER(IntKi) :: LinInputs !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] INTEGER(IntKi) :: LinOutputs !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] LOGICAL :: LinOutJac !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] LOGICAL :: LinOutMod !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] - TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] + TYPE(FAST_VTK_ModeShapeType) :: VTK_modes !< Data for VTK mode-shape visualization [-] INTEGER(IntKi) :: Lin_NumMods !< number of modules in the linearization [-] INTEGER(IntKi) , DIMENSION(NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] - CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] + INTEGER(IntKi) :: LinInterpOrder !< Interpolation order for CalcSteady solution [-] END TYPE FAST_ParameterType ! ======================= +! ========= FAST_LinStateSave ======= + TYPE, PUBLIC :: FAST_LinStateSave + TYPE(IceD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x_IceD !< Continuous states [-] + TYPE(IceD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd_IceD !< Discrete states [-] + TYPE(IceD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z_IceD !< Constraint states [-] + TYPE(IceD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt_IceD !< Other states [-] + TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_IceD !< System inputs [-] + TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x_BD !< Continuous states [-] + TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd_BD !< Discrete states [-] + TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z_BD !< Constraint states [-] + TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt_BD !< Other states [-] + TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BD !< System inputs [-] + TYPE(ED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_ED !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_ED !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_ED !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_ED !< Other states [-] + TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: u_ED !< System inputs [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SrvD !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SrvD !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SrvD !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SrvD !< Other states [-] + TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: u_SrvD !< System inputs [-] + TYPE(AD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_AD !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_AD !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_AD !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_AD !< Other states [-] + TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: u_AD !< System inputs [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IfW !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IfW !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IfW !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_IfW !< Other states [-] + TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: u_IfW !< System inputs [-] + TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SD !< Continuous states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SD !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SD !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SD !< Other states [-] + TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: u_SD !< System inputs [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_ExtPtfm !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_ExtPtfm !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_ExtPtfm !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_ExtPtfm !< Other states [-] + TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: u_ExtPtfm !< System inputs [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_HD !< Continuous states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_HD !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_HD !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_HD !< Other states [-] + TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: u_HD !< System inputs [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IceF !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IceF !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IceF !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_IceF !< Other states [-] + TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: u_IceF !< System inputs [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_MAP !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_MAP !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_MAP !< Constraint states [-] + TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: u_MAP !< System inputs [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_FEAM !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_FEAM !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_FEAM !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_FEAM !< Other states [-] + TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: u_FEAM !< System inputs [-] + TYPE(MD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_MD !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_MD !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_MD !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_MD !< Other states [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: u_MD !< System inputs [-] + END TYPE FAST_LinStateSave +! ======================= ! ========= FAST_LinType ======= TYPE, PUBLIC :: FAST_LinType CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: Names_u !< Names of the linearized inputs [-] @@ -193,6 +295,8 @@ MODULE FAST_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: op_dx !< 1st time derivative of continuous state operating point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: op_xd !< discrete state operating point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: op_z !< constraint state operating point [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: op_x_eig_mag !< continuous state eigenvector magnitude [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: op_x_eig_phase !< continuous state eigenvector phase [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: Use_u !< array same size as names_u, which indicates if this input is used in linearization output file [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: Use_y !< array same size as names_y, which indicates if this output is used in linearization output file [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] @@ -207,6 +311,7 @@ MODULE FAST_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Whether corresponding output is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Whether corresponding continuous state is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_z !< Whether corresponding constraint state is in rotating frame [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Derivative order for continuous states [-] INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] INTEGER(IntKi) :: NumOutputs !< number of WriteOutputs in each linearized module [-] @@ -222,9 +327,26 @@ MODULE FAST_Types TYPE(FAST_ModLinType) , DIMENSION(NumModules) :: Modules !< Linearization data for each module [-] TYPE(FAST_LinType) :: Glue !< Linearization data for the glue code (coupled system) [-] REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: Azimuth + REAL(ReKi) :: Azimuth !< Rotor azimuth position [rad] + REAL(ReKi) :: WindSpeed !< Wind speed at reference height [m/s] END TYPE FAST_LinFileType ! ======================= +! ========= FAST_MiscLinType ======= + TYPE, PUBLIC :: FAST_MiscLinType + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] + INTEGER(IntKi) :: CopyOP_CtrlCode !< mesh control code for copy type (new on first call; update otherwise) [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] + LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] + LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] + INTEGER(IntKi) :: n_rot !< number of rotations completed in CalcSteady algorithm [-] + INTEGER(IntKi) :: AzimIndx !< index into target azimuth array in CalcSteady algorithm [-] + INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Psi !< Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_interp !< Interpolated outputs packed into an array [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_ref !< Reference output range for CalcSteady error calculation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y_prevRot !< Linearization outputs from previous rotor revolution at each target azimuth [-] + END TYPE FAST_MiscLinType +! ======================= ! ========= FAST_OutputFileType ======= TYPE, PUBLIC :: FAST_OutputFileType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] @@ -240,9 +362,13 @@ MODULE FAST_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< version information from all modules [-] CHARACTER(ChanLen) , DIMENSION(NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] + LOGICAL :: WriteThisStep !< Whether this step will be written in the FAST output files [-] INTEGER(IntKi) :: VTK_count !< Number of VTK files written (for naming output files) [-] INTEGER(IntKi) :: VTK_LastWaveIndx !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] + INTEGER(IntKi) :: ActualChanLen !< width of the column headers output in the text and/or binary file [-] + CHARACTER(30) :: OutFmt_a !< Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces [-] + TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -269,6 +395,8 @@ MODULE FAST_Types TYPE(BD_InputType) , DIMENSION(:), ALLOCATABLE :: u !< System inputs [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(BD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] + TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE BeamDyn_Data @@ -283,7 +411,8 @@ MODULE FAST_Types TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with InputTimes [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ElastoDyn_Data @@ -298,6 +427,8 @@ MODULE FAST_Types TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] TYPE(SrvD_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] + TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ServoDyn_Data @@ -326,6 +457,8 @@ MODULE FAST_Types TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] TYPE(AD_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDyn_Data @@ -340,6 +473,8 @@ MODULE FAST_Types TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE InflowWind_Data @@ -397,6 +532,8 @@ MODULE FAST_Types TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] TYPE(HydroDyn_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE HydroDyn_Data @@ -425,6 +562,8 @@ MODULE FAST_Types TYPE(MAP_InputType) :: u !< System inputs [-] TYPE(MAP_OutputType) :: y !< System outputs [-] TYPE(MAP_OtherStateType) :: OtherSt_old !< Other/optimization states (copied for the case of subcycling) [-] + TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MAP_Data @@ -505,7 +644,7 @@ MODULE FAST_Types TYPE(MeshMapType) :: SD_P_2_IceF_P !< Map SubDyn y2Mesh point mesh to IceFloe point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: IceD_P_2_SD_P !< Map IceDyn point mesh to SubDyn y2Mesh point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SD_P_2_IceD_P !< Map SubDyn y2Mesh point mesh to IceDyn point mesh [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Jacobian_Opt1 !< Stored Jacobian in ED_HD_InputOutputSolve or ED_SD_HD_BD_InputOutputSolve [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Jacobian_Opt1 !< Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Jacobian_pivot !< Pivot array used for LU decomposition of Jacobian_Opt1 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] TYPE(MeshType) :: u_ED_PlatformPtMesh !< copy of ED input mesh [-] @@ -530,11 +669,49 @@ MODULE FAST_Types REAL(ReKi) :: ElecPwr !< electric power input from Simulink/Labview [-] REAL(ReKi) :: YawPosCom !< yaw position command from Simulink/Labview [-] REAL(ReKi) :: YawRateCom !< yaw rate command from Simulink/Labview [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad] REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] END TYPE FAST_ExternInputType ! ======================= +! ========= FAST_InitData ======= + TYPE, PUBLIC :: FAST_InitData + TYPE(ED_InitInputType) :: InData_ED !< ED Initialization input data [-] + TYPE(ED_InitOutputType) :: OutData_ED !< ED Initialization output data [-] + TYPE(BD_InitInputType) :: InData_BD !< BD Initialization input data [-] + TYPE(BD_InitOutputType) , DIMENSION(:), ALLOCATABLE :: OutData_BD !< BD Initialization output data [-] + TYPE(SrvD_InitInputType) :: InData_SrvD !< SrvD Initialization input data [-] + TYPE(SrvD_InitOutputType) :: OutData_SrvD !< SrvD Initialization output data [-] + TYPE(AD14_InitInputType) :: InData_AD14 !< AD14 Initialization input data [-] + TYPE(AD14_InitOutputType) :: OutData_AD14 !< AD14 Initialization output data [-] + TYPE(AD_InitInputType) :: InData_AD !< AD Initialization input data [-] + TYPE(AD_InitOutputType) :: OutData_AD !< AD Initialization output data [-] + TYPE(InflowWind_InitInputType) :: InData_IfW !< IfW Initialization input data [-] + TYPE(InflowWind_InitOutputType) :: OutData_IfW !< IfW Initialization output data [-] + TYPE(OpFM_InitInputType) :: InData_OpFM !< OpFM Initialization input data [-] + TYPE(OpFM_InitOutputType) :: OutData_OpFM !< OpFM Initialization output data [-] + TYPE(HydroDyn_InitInputType) :: InData_HD !< HD Initialization input data [-] + TYPE(HydroDyn_InitOutputType) :: OutData_HD !< HD Initialization output data [-] + TYPE(SD_InitInputType) :: InData_SD !< SD Initialization input data [-] + TYPE(SD_InitOutputType) :: OutData_SD !< SD Initialization output data [-] + TYPE(ExtPtfm_InitInputType) :: InData_ExtPtfm !< ExtPtfm Initialization input data [-] + TYPE(ExtPtfm_InitOutputType) :: OutData_ExtPtfm !< ExtPtfm Initialization output data [-] + TYPE(MAP_InitInputType) :: InData_MAP !< MAP Initialization input data [-] + TYPE(MAP_InitOutputType) :: OutData_MAP !< MAP Initialization output data [-] + TYPE(FEAM_InitInputType) :: InData_FEAM !< FEAM Initialization input data [-] + TYPE(FEAM_InitOutputType) :: OutData_FEAM !< FEAM Initialization output data [-] + TYPE(MD_InitInputType) :: InData_MD !< MD Initialization input data [-] + TYPE(MD_InitOutputType) :: OutData_MD !< MD Initialization output data [-] + TYPE(Orca_InitInputType) :: InData_Orca !< Orca Initialization input data [-] + TYPE(Orca_InitOutputType) :: OutData_Orca !< Orca Initialization output data [-] + TYPE(IceFloe_InitInputType) :: InData_IceF !< IceF Initialization input data [-] + TYPE(IceFloe_InitOutputType) :: OutData_IceF !< IceF Initialization output data [-] + TYPE(IceD_InitInputType) :: InData_IceD !< IceD Initialization input data [-] + TYPE(IceD_InitOutputType) :: OutData_IceD !< IceD Initialization output data (each instance will have the same output channels) [-] + TYPE(SC_InitInputType) :: InData_SC !< SC Initialization input data [-] + TYPE(SC_InitOutputType) :: OutData_SC !< SC Initialization output data [-] + END TYPE FAST_InitData +! ======================= ! ========= FAST_MiscVarType ======= TYPE, PUBLIC :: FAST_MiscVarType REAL(DbKi) :: TiLstPrn !< The simulation time of the last print (to file) [(s)] @@ -547,7 +724,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime !< Start time of simulation (after initialization) [-] LOGICAL :: calcJacobian !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] - INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] END TYPE FAST_MiscVarType ! ======================= ! ========= FAST_ExternInitType ======= @@ -727,8 +904,14 @@ SUBROUTINE FAST_PackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AirfoilCoords)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AirfoilCoords))-1 ) = PACK(InData%AirfoilCoords,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AirfoilCoords) + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE FAST_PackVTK_BLSurfaceType @@ -745,12 +928,6 @@ SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -786,15 +963,14 @@ SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AirfoilCoords)>0) OutData%AirfoilCoords = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AirfoilCoords))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%AirfoilCoords) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE FAST_UnPackVTK_BLSurfaceType @@ -1029,14 +1205,18 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSectors - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GroundRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NacelleBox))-1 ) = PACK(InData%NacelleBox,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NacelleBox) + IntKiBuf(Int_Xferred) = InData%NumSectors + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GroundRad + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) + DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) + ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1047,11 +1227,15 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TowerRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TowerRad))-1 ) = PACK(InData%TowerRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TowerRad) + DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) + ReKiBuf(Re_Xferred) = InData%TowerRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NWaveElevPts))-1 ) = PACK(InData%NWaveElevPts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NWaveElevPts) + DO i1 = LBOUND(InData%NWaveElevPts,1), UBOUND(InData%NWaveElevPts,1) + IntKiBuf(Int_Xferred) = InData%NWaveElevPts(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1065,8 +1249,12 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1081,8 +1269,12 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1135,8 +1327,10 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MorisonRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MorisonRad))-1 ) = PACK(InData%MorisonRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MorisonRad) + DO i1 = LBOUND(InData%MorisonRad,1), UBOUND(InData%MorisonRad,1) + ReKiBuf(Re_Xferred) = InData%MorisonRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackVTK_SurfaceType @@ -1153,12 +1347,6 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1174,25 +1362,22 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSectors = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HubRad = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%GroundRad = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%NumSectors = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HubRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%GroundRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%NacelleBox,1) i1_u = UBOUND(OutData%NacelleBox,1) i2_l = LBOUND(OutData%NacelleBox,2) i2_u = UBOUND(OutData%NacelleBox,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%NacelleBox = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NacelleBox))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%NacelleBox) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) + DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) + OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1206,27 +1391,17 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TowerRad)>0) OutData%TowerRad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TowerRad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%TowerRad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) + OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%NWaveElevPts,1) i1_u = UBOUND(OutData%NWaveElevPts,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%NWaveElevPts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NWaveElevPts))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NWaveElevPts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NWaveElevPts,1), UBOUND(OutData%NWaveElevPts,1) + OutData%NWaveElevPts(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1243,15 +1418,12 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 @@ -1269,15 +1441,12 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated Int_Xferred = Int_Xferred + 1 @@ -1348,17 +1517,553 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%MorisonRad,1), UBOUND(OutData%MorisonRad,1) + OutData%MorisonRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackVTK_SurfaceType + + SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: SrcVTK_ModeShapeTypeData + TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: DstVTK_ModeShapeTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyVTK_ModeShapeType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot + DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName + DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%VTKModes)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%VTKModes)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%VTKModes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes +ENDIF + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampingRatio)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampingRatio)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) + i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) + i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) + i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) + i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_magnitude)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_phase)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) + i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) + i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) + i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) + i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_phase)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase +ENDIF + END SUBROUTINE FAST_CopyVTK_ModeShapeType + + SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ) + TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: VTK_ModeShapeTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(VTK_ModeShapeTypeData%VTKModes)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%VTKModes) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%DampingRatio)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%DampingRatio) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%NaturalFreq_Hz) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%DampedFreq_Hz)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%DampedFreq_Hz) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_magnitude)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%x_eig_magnitude) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_phase)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%x_eig_phase) +ENDIF + END SUBROUTINE FAST_DestroyVTK_ModeShapeType + + SUBROUTINE FAST_PackVTK_ModeShapeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackVTK_ModeShapeType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%CheckpointRoot) ! CheckpointRoot + Int_BufSz = Int_BufSz + 1*LEN(InData%MatlabFileName) ! MatlabFileName + Int_BufSz = Int_BufSz + 1 ! VTKLinModes + Int_BufSz = Int_BufSz + 1 ! VTKModes allocated yes/no + IF ( ALLOCATED(InData%VTKModes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VTKModes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%VTKModes) ! VTKModes + END IF + Int_BufSz = Int_BufSz + 1 ! VTKLinTim + Int_BufSz = Int_BufSz + 1 ! VTKNLinTimes + Re_BufSz = Re_BufSz + 1 ! VTKLinScale + Re_BufSz = Re_BufSz + 1 ! VTKLinPhase + Int_BufSz = Int_BufSz + 1 ! DampingRatio allocated yes/no + IF ( ALLOCATED(InData%DampingRatio) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DampingRatio upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%DampingRatio) ! DampingRatio + END IF + Int_BufSz = Int_BufSz + 1 ! NaturalFreq_Hz allocated yes/no + IF ( ALLOCATED(InData%NaturalFreq_Hz) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NaturalFreq_Hz upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%NaturalFreq_Hz) ! NaturalFreq_Hz + END IF + Int_BufSz = Int_BufSz + 1 ! DampedFreq_Hz allocated yes/no + IF ( ALLOCATED(InData%DampedFreq_Hz) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DampedFreq_Hz upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%DampedFreq_Hz) ! DampedFreq_Hz + END IF + Int_BufSz = Int_BufSz + 1 ! x_eig_magnitude allocated yes/no + IF ( ALLOCATED(InData%x_eig_magnitude) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! x_eig_magnitude upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%x_eig_magnitude) ! x_eig_magnitude + END IF + Int_BufSz = Int_BufSz + 1 ! x_eig_phase allocated yes/no + IF ( ALLOCATED(InData%x_eig_phase) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! x_eig_phase upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%x_eig_phase) ! x_eig_phase + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%CheckpointRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%CheckpointRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%MatlabFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%MatlabFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%VTKLinModes + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%VTKModes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VTKModes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTKModes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VTKModes,1), UBOUND(InData%VTKModes,1) + IntKiBuf(Int_Xferred) = InData%VTKModes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%VTKLinTim + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKNLinTimes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VTKLinScale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VTKLinPhase + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%DampingRatio) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DampingRatio,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampingRatio,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DampingRatio,1), UBOUND(InData%DampingRatio,1) + DbKiBuf(Db_Xferred) = InData%DampingRatio(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NaturalFreq_Hz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NaturalFreq_Hz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NaturalFreq_Hz,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NaturalFreq_Hz,1), UBOUND(InData%NaturalFreq_Hz,1) + DbKiBuf(Db_Xferred) = InData%NaturalFreq_Hz(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DampedFreq_Hz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DampedFreq_Hz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampedFreq_Hz,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DampedFreq_Hz,1), UBOUND(InData%DampedFreq_Hz,1) + DbKiBuf(Db_Xferred) = InData%DampedFreq_Hz(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%x_eig_magnitude) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%x_eig_magnitude,3), UBOUND(InData%x_eig_magnitude,3) + DO i2 = LBOUND(InData%x_eig_magnitude,2), UBOUND(InData%x_eig_magnitude,2) + DO i1 = LBOUND(InData%x_eig_magnitude,1), UBOUND(InData%x_eig_magnitude,1) + DbKiBuf(Db_Xferred) = InData%x_eig_magnitude(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%x_eig_phase) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%x_eig_phase,3), UBOUND(InData%x_eig_phase,3) + DO i2 = LBOUND(InData%x_eig_phase,2), UBOUND(InData%x_eig_phase,2) + DO i1 = LBOUND(InData%x_eig_phase,1), UBOUND(InData%x_eig_phase,1) + DbKiBuf(Db_Xferred) = InData%x_eig_phase(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FAST_PackVTK_ModeShapeType + + SUBROUTINE FAST_UnPackVTK_ModeShapeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%CheckpointRoot) + OutData%CheckpointRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%MatlabFileName) + OutData%MatlabFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%VTKLinModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTKModes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VTKModes)) DEALLOCATE(OutData%VTKModes) + ALLOCATE(OutData%VTKModes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VTKModes,1), UBOUND(OutData%VTKModes,1) + OutData%VTKModes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%VTKLinTim = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKNLinTimes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKLinScale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VTKLinPhase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampingRatio not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DampingRatio)) DEALLOCATE(OutData%DampingRatio) + ALLOCATE(OutData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%MorisonRad)>0) OutData%MorisonRad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MorisonRad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%MorisonRad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DampingRatio,1), UBOUND(OutData%DampingRatio,1) + OutData%DampingRatio(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackVTK_SurfaceType + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NaturalFreq_Hz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NaturalFreq_Hz)) DEALLOCATE(OutData%NaturalFreq_Hz) + ALLOCATE(OutData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NaturalFreq_Hz,1), UBOUND(OutData%NaturalFreq_Hz,1) + OutData%NaturalFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampedFreq_Hz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DampedFreq_Hz)) DEALLOCATE(OutData%DampedFreq_Hz) + ALLOCATE(OutData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DampedFreq_Hz,1), UBOUND(OutData%DampedFreq_Hz,1) + OutData%DampedFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_magnitude not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_eig_magnitude)) DEALLOCATE(OutData%x_eig_magnitude) + ALLOCATE(OutData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%x_eig_magnitude,3), UBOUND(OutData%x_eig_magnitude,3) + DO i2 = LBOUND(OutData%x_eig_magnitude,2), UBOUND(OutData%x_eig_magnitude,2) + DO i1 = LBOUND(OutData%x_eig_magnitude,1), UBOUND(OutData%x_eig_magnitude,1) + OutData%x_eig_magnitude(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_phase not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_eig_phase)) DEALLOCATE(OutData%x_eig_phase) + ALLOCATE(OutData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%x_eig_phase,3), UBOUND(OutData%x_eig_phase,3) + DO i2 = LBOUND(OutData%x_eig_phase,2), UBOUND(OutData%x_eig_phase,2) + DO i1 = LBOUND(OutData%x_eig_phase,1), UBOUND(OutData%x_eig_phase,1) + OutData%x_eig_phase(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FAST_UnPackVTK_ModeShapeType SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN) :: SrcParamData @@ -1414,6 +2119,7 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WrSttsTime = SrcParamData%WrSttsTime DstParamData%n_SttsTime = SrcParamData%n_SttsTime DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%n_DT_Out = SrcParamData%n_DT_Out DstParamData%n_VTKTime = SrcParamData%n_VTKTime DstParamData%TurbineType = SrcParamData%TurbineType DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile @@ -1430,29 +2136,32 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%TChanLen = SrcParamData%TChanLen DstParamData%OutFileRoot = SrcParamData%OutFileRoot DstParamData%FTitle = SrcParamData%FTitle -IF (ALLOCATED(SrcParamData%LinTimes)) THEN - i1_l = LBOUND(SrcParamData%LinTimes,1) - i1_u = UBOUND(SrcParamData%LinTimes,1) - IF (.NOT. ALLOCATED(DstParamData%LinTimes)) THEN - ALLOCATE(DstParamData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LinTimes = SrcParamData%LinTimes -ENDIF + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth + DstParamData%VTK_fps = SrcParamData%VTK_fps + CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstParamData%TurbinePos = SrcParamData%TurbinePos + DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%CalcSteady = SrcParamData%CalcSteady + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimTol = SrcParamData%TrimTol + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp + DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp + DstParamData%NLinTimes = SrcParamData%NLinTimes + DstParamData%AzimDelta = SrcParamData%AzimDelta DstParamData%LinInputs = SrcParamData%LinInputs DstParamData%LinOutputs = SrcParamData%LinOutputs DstParamData%LinOutJac = SrcParamData%LinOutJac DstParamData%LinOutMod = SrcParamData%LinOutMod - CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) + CALL FAST_Copyvtk_modeshapetype( SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%TurbinePos = SrcParamData%TurbinePos DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder - DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder END SUBROUTINE FAST_CopyParam SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -1464,10 +2173,8 @@ SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ParamData%LinTimes)) THEN - DEALLOCATE(ParamData%LinTimes) -ENDIF CALL FAST_Destroyvtk_surfacetype( ParamData%VTK_surface, ErrStat, ErrMsg ) + CALL FAST_Destroyvtk_modeshapetype( ParamData%VTK_modes, ErrStat, ErrMsg ) END SUBROUTINE FAST_DestroyParam SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1544,6 +2251,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! WrSttsTime Int_BufSz = Int_BufSz + 1 ! n_SttsTime Int_BufSz = Int_BufSz + 1 ! n_ChkptTime + Int_BufSz = Int_BufSz + 1 ! n_DT_Out Int_BufSz = Int_BufSz + 1 ! n_VTKTime Int_BufSz = Int_BufSz + 1 ! TurbineType Int_BufSz = Int_BufSz + 1 ! WrBinOutFile @@ -1560,15 +2268,9 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! TChanLen Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no - IF ( ALLOCATED(InData%LinTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes - END IF - Int_BufSz = Int_BufSz + 1 ! LinInputs - Int_BufSz = Int_BufSz + 1 ! LinOutputs - Int_BufSz = Int_BufSz + 1 ! LinOutJac - Int_BufSz = Int_BufSz + 1 ! LinOutMod + Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot + Int_BufSz = Int_BufSz + 1 ! VTK_tWidth + Db_BufSz = Db_BufSz + 1 ! VTK_fps ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface @@ -1588,9 +2290,39 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 + Re_BufSz = Re_BufSz + 1 ! TrimTol + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! Twr_Kdmp + Re_BufSz = Re_BufSz + 1 ! Bld_Kdmp + Int_BufSz = Int_BufSz + 1 ! NLinTimes + Db_BufSz = Db_BufSz + 1 ! AzimDelta + Int_BufSz = Int_BufSz + 1 ! LinInputs + Int_BufSz = Int_BufSz + 1 ! LinOutputs + Int_BufSz = Int_BufSz + 1 ! LinOutJac + Int_BufSz = Int_BufSz + 1 ! LinOutMod + Int_BufSz = Int_BufSz + 3 ! VTK_modes: size of buffers for each call to pack subtype + CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VTK_modes + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VTK_modes + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VTK_modes + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Lin_NumMods Int_BufSz = Int_BufSz + SIZE(InData%Lin_ModOrder) ! Lin_ModOrder - Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc + Int_BufSz = Int_BufSz + 1 ! LinInterpOrder IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1618,167 +2350,164 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DT_module))-1 ) = PACK(InData%DT_module,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DT_module) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n_substeps))-1 ) = PACK(InData%n_substeps,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n_substeps) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_TMax_m1 - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCrctn - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%KMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numIceLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nBeams - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BD_OutputSibling , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ModuleInitialized)-1 ) = TRANSFER(PACK( InData%ModuleInitialized ,.TRUE.), IntKiBuf(1), SIZE(InData%ModuleInitialized)) - Int_Xferred = Int_Xferred + SIZE(InData%ModuleInitialized) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT_Ujac - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UJacSclFact - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SizeJac_Opt1))-1 ) = PACK(InData%SizeJac_Opt1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SizeJac_Opt1) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompElast - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompAero - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompServo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompHydro - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompSub - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompMooring - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompIce - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%EDFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%DT_module,1), UBOUND(InData%DT_module,1) + DbKiBuf(Db_Xferred) = InData%DT_module(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%n_substeps,1), UBOUND(InData%n_substeps,1) + IntKiBuf(Int_Xferred) = InData%n_substeps(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%n_TMax_m1 + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InterpOrder + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCrctn + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%KMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numIceLegs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nBeams + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BD_OutputSibling, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ModuleInitialized,1), UBOUND(InData%ModuleInitialized,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ModuleInitialized(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%DT_Ujac + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UJacSclFact + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%SizeJac_Opt1,1), UBOUND(InData%SizeJac_Opt1,1) + IntKiBuf(Int_Xferred) = InData%SizeJac_Opt1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%CompElast + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompInflow + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompAero + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompServo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompHydro + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompSub + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompMooring + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompIce + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%EDFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I DO i1 = LBOUND(InData%BDBldFile,1), UBOUND(InData%BDBldFile,1) - DO I = 1, LEN(InData%BDBldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%AeroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ServoFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HydroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SubFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MooringFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IceFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TStart - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT_Out - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrSttsTime , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_SttsTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbineType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrBinOutFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrTxtOutFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WrBinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%VTK_fields , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%LinTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + DO I = 1, LEN(InData%BDBldFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + DO I = 1, LEN(InData%InflowFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%AeroFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%ServoFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HydroFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%SubFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%MooringFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%IceFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%TStart + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT_Out + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSttsTime, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = InData%n_SttsTime Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%LinTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LinTimes))-1 ) = PACK(InData%LinTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LinTimes) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinOutJac , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinOutMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_ChkptTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_DT_Out + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_VTKTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbineType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrBinMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_Type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VTK_fields, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt_t) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%FmtWidth + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TChanLen + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%FTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%VTK_OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%VTK_tWidth + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%VTK_fps + Db_Xferred = Db_Xferred + 1 CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1807,16 +2536,74 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TurbinePos))-1 ) = PACK(InData%TurbinePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TurbinePos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Lin_NumMods - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Lin_ModOrder))-1 ) = PACK(InData%Lin_ModOrder,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Lin_ModOrder) - DO I = 1, LEN(InData%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + 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 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcSteady, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimTol + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Twr_Kdmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Bld_Kdmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLinTimes + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimDelta + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinInputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%Lin_NumMods + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) + IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%LinInterpOrder + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackParam SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1832,12 +2619,6 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1852,222 +2633,174 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%DT_module,1) i1_u = UBOUND(OutData%DT_module,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DT_module = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DT_module))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%DT_module) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DT_module,1), UBOUND(OutData%DT_module,1) + OutData%DT_module(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%n_substeps,1) i1_u = UBOUND(OutData%n_substeps,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n_substeps = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n_substeps))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n_substeps) - DEALLOCATE(mask1) - OutData%n_TMax_m1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%InterpOrder = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCrctn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%KMax = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numIceLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nBeams = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BD_OutputSibling = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%n_substeps,1), UBOUND(OutData%n_substeps,1) + OutData%n_substeps(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%n_TMax_m1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%InterpOrder = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCrctn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%KMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numIceLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nBeams = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BD_OutputSibling = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD_OutputSibling) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ModuleInitialized,1) i1_u = UBOUND(OutData%ModuleInitialized,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ModuleInitialized = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ModuleInitialized))-1 ), OutData%ModuleInitialized), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ModuleInitialized) - DEALLOCATE(mask1) - OutData%DT_Ujac = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%UJacSclFact = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ModuleInitialized,1), UBOUND(OutData%ModuleInitialized,1) + OutData%ModuleInitialized(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ModuleInitialized(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%DT_Ujac = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%UJacSclFact = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%SizeJac_Opt1,1) i1_u = UBOUND(OutData%SizeJac_Opt1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SizeJac_Opt1 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SizeJac_Opt1))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SizeJac_Opt1) - DEALLOCATE(mask1) - OutData%CompElast = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompInflow = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompAero = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompServo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompHydro = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompSub = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompMooring = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompIce = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%EDFile) - OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%SizeJac_Opt1,1), UBOUND(OutData%SizeJac_Opt1,1) + OutData%SizeJac_Opt1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%CompElast = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompAero = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompServo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompHydro = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompSub = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompMooring = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompIce = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%EDFile) + OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%BDBldFile,1) i1_u = UBOUND(OutData%BDBldFile,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%BDBldFile,1), UBOUND(OutData%BDBldFile,1) - DO I = 1, LEN(OutData%BDBldFile) - OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%AeroFile) - OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ServoFile) - OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HydroFile) - OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SubFile) - OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MooringFile) - OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%BDBldFile) + OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - DO I = 1, LEN(OutData%IceFile) - OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TStart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DT_Out = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WrSttsTime = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%n_SttsTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_ChkptTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_Type = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fields = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes not allocated + END DO + DO I = 1, LEN(OutData%InflowFile) + OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%AeroFile) + OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%ServoFile) + OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HydroFile) + OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%SubFile) + OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%MooringFile) + OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%IceFile) + OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DT_Out = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WrSttsTime = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSttsTime) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%n_SttsTime = 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%LinTimes)) DEALLOCATE(OutData%LinTimes) - ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LinTimes)>0) OutData%LinTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LinTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%LinTimes) - DEALLOCATE(mask1) - END IF - OutData%LinInputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%n_ChkptTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_DT_Out = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_VTKTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TurbineType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) + Int_Xferred = Int_Xferred + 1 + OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) + Int_Xferred = Int_Xferred + 1 + OutData%WrBinMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_Type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_fields = TRANSFER(IntKiBuf(Int_Xferred), OutData%VTK_fields) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt_t) + OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%FmtWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TChanLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFileRoot) + OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%FTitle) + OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%VTK_OutFileRoot) + OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%VTK_tWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_fps = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2110,37 +2843,93 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%TurbinePos,1) i1_u = UBOUND(OutData%TurbinePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TurbinePos = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TurbinePos))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%TurbinePos) - DEALLOCATE(mask1) - OutData%Lin_NumMods = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 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 + END DO ! I + OutData%CalcSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcSteady) + Int_Xferred = Int_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Twr_Kdmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Bld_Kdmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NLinTimes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AzimDelta = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%LinInputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_modes, ErrStat2, ErrMsg2 ) ! VTK_modes + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%Lin_NumMods = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Lin_ModOrder,1) i1_u = UBOUND(OutData%Lin_ModOrder,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Lin_ModOrder = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Lin_ModOrder))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Lin_ModOrder) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%Lin_ModOrder,1), UBOUND(OutData%Lin_ModOrder,1) + OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%LinInterpOrder = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackParam - SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData - TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData + SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinStateSave), INTENT(INOUT) :: SrcLinStateSaveData + TYPE(FAST_LinStateSave), INTENT(INOUT) :: DstLinStateSaveData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -2150,1765 +2939,3020 @@ SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinStateSave' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_u,1) - i1_u = UBOUND(SrcLinTypeData%Names_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN - ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%x_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%x_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%x_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceD)) THEN + ALLOCATE(DstLinStateSaveData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_u = SrcLinTypeData%Names_u + DO i2 = LBOUND(SrcLinStateSaveData%x_IceD,2), UBOUND(SrcLinStateSaveData%x_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%x_IceD,1), UBOUND(SrcLinStateSaveData%x_IceD,1) + CALL IceD_CopyContState( SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_y,1) - i1_u = UBOUND(SrcLinTypeData%Names_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN - ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%xd_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%xd_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%xd_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceD)) THEN + ALLOCATE(DstLinStateSaveData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_y = SrcLinTypeData%Names_y + DO i2 = LBOUND(SrcLinStateSaveData%xd_IceD,2), UBOUND(SrcLinStateSaveData%xd_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%xd_IceD,1), UBOUND(SrcLinStateSaveData%xd_IceD,1) + CALL IceD_CopyDiscState( SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_x,1) - i1_u = UBOUND(SrcLinTypeData%Names_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN - ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%z_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%z_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%z_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceD)) THEN + ALLOCATE(DstLinStateSaveData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_x = SrcLinTypeData%Names_x + DO i2 = LBOUND(SrcLinStateSaveData%z_IceD,2), UBOUND(SrcLinStateSaveData%z_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%z_IceD,1), UBOUND(SrcLinStateSaveData%z_IceD,1) + CALL IceD_CopyConstrState( SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_xd,1) - i1_u = UBOUND(SrcLinTypeData%Names_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN - ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd + DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2), UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1), UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) + CALL IceD_CopyOtherState( SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_z,1) - i1_u = UBOUND(SrcLinTypeData%Names_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN - ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%u_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%u_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%u_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceD)) THEN + ALLOCATE(DstLinStateSaveData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_z = SrcLinTypeData%Names_z + DO i2 = LBOUND(SrcLinStateSaveData%u_IceD,2), UBOUND(SrcLinStateSaveData%u_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%u_IceD,1), UBOUND(SrcLinStateSaveData%u_IceD,1) + CALL IceD_CopyInput( SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_u)) THEN - i1_l = LBOUND(SrcLinTypeData%op_u,1) - i1_u = UBOUND(SrcLinTypeData%op_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN - ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%x_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%x_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%x_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_BD)) THEN + ALLOCATE(DstLinStateSaveData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_u = SrcLinTypeData%op_u + DO i2 = LBOUND(SrcLinStateSaveData%x_BD,2), UBOUND(SrcLinStateSaveData%x_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%x_BD,1), UBOUND(SrcLinStateSaveData%x_BD,1) + CALL BD_CopyContState( SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_y)) THEN - i1_l = LBOUND(SrcLinTypeData%op_y,1) - i1_u = UBOUND(SrcLinTypeData%op_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN - ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%xd_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%xd_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%xd_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_BD)) THEN + ALLOCATE(DstLinStateSaveData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_y = SrcLinTypeData%op_y + DO i2 = LBOUND(SrcLinStateSaveData%xd_BD,2), UBOUND(SrcLinStateSaveData%xd_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%xd_BD,1), UBOUND(SrcLinStateSaveData%xd_BD,1) + CALL BD_CopyDiscState( SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x,1) - i1_u = UBOUND(SrcLinTypeData%op_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN - ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%z_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%z_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%z_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_BD)) THEN + ALLOCATE(DstLinStateSaveData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_x = SrcLinTypeData%op_x + DO i2 = LBOUND(SrcLinStateSaveData%z_BD,2), UBOUND(SrcLinStateSaveData%z_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%z_BD,1), UBOUND(SrcLinStateSaveData%z_BD,1) + CALL BD_CopyConstrState( SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN - i1_l = LBOUND(SrcLinTypeData%op_dx,1) - i1_u = UBOUND(SrcLinTypeData%op_dx,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN - ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_BD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_dx = SrcLinTypeData%op_dx + DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_BD,2), UBOUND(SrcLinStateSaveData%OtherSt_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_BD,1), UBOUND(SrcLinStateSaveData%OtherSt_BD,1) + CALL BD_CopyOtherState( SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%op_xd,1) - i1_u = UBOUND(SrcLinTypeData%op_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN - ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%u_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%u_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%u_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_BD)) THEN + ALLOCATE(DstLinStateSaveData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_xd = SrcLinTypeData%op_xd + DO i2 = LBOUND(SrcLinStateSaveData%u_BD,2), UBOUND(SrcLinStateSaveData%u_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%u_BD,1), UBOUND(SrcLinStateSaveData%u_BD,1) + CALL BD_CopyInput( SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_z)) THEN - i1_l = LBOUND(SrcLinTypeData%op_z,1) - i1_u = UBOUND(SrcLinTypeData%op_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN - ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%x_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ED)) THEN + ALLOCATE(DstLinStateSaveData%x_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_z = SrcLinTypeData%op_z + DO i1 = LBOUND(SrcLinStateSaveData%x_ED,1), UBOUND(SrcLinStateSaveData%x_ED,1) + CALL ED_CopyContState( SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_u,1) - i1_u = UBOUND(SrcLinTypeData%Use_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN - ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%xd_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ED)) THEN + ALLOCATE(DstLinStateSaveData%xd_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Use_u = SrcLinTypeData%Use_u + DO i1 = LBOUND(SrcLinStateSaveData%xd_ED,1), UBOUND(SrcLinStateSaveData%xd_ED,1) + CALL ED_CopyDiscState( SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_y,1) - i1_u = UBOUND(SrcLinTypeData%Use_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN - ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%z_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%z_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ED)) THEN + ALLOCATE(DstLinStateSaveData%z_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Use_y = SrcLinTypeData%Use_y + DO i1 = LBOUND(SrcLinStateSaveData%z_ED,1), UBOUND(SrcLinStateSaveData%z_ED,1) + CALL ED_CopyConstrState( SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%A)) THEN - i1_l = LBOUND(SrcLinTypeData%A,1) - i1_u = UBOUND(SrcLinTypeData%A,1) - i2_l = LBOUND(SrcLinTypeData%A,2) - i2_u = UBOUND(SrcLinTypeData%A,2) - IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN - ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ED)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%A = SrcLinTypeData%A + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ED,1), UBOUND(SrcLinStateSaveData%OtherSt_ED,1) + CALL ED_CopyOtherState( SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%B)) THEN - i1_l = LBOUND(SrcLinTypeData%B,1) - i1_u = UBOUND(SrcLinTypeData%B,1) - i2_l = LBOUND(SrcLinTypeData%B,2) - i2_u = UBOUND(SrcLinTypeData%B,2) - IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN - ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%u_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%u_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ED)) THEN + ALLOCATE(DstLinStateSaveData%u_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%B = SrcLinTypeData%B + DO i1 = LBOUND(SrcLinStateSaveData%u_ED,1), UBOUND(SrcLinStateSaveData%u_ED,1) + CALL ED_CopyInput( SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%C)) THEN - i1_l = LBOUND(SrcLinTypeData%C,1) - i1_u = UBOUND(SrcLinTypeData%C,1) - i2_l = LBOUND(SrcLinTypeData%C,2) - i2_u = UBOUND(SrcLinTypeData%C,2) - IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN - ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%C = SrcLinTypeData%C + DO i1 = LBOUND(SrcLinStateSaveData%x_SrvD,1), UBOUND(SrcLinStateSaveData%x_SrvD,1) + CALL SrvD_CopyContState( SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%D)) THEN - i1_l = LBOUND(SrcLinTypeData%D,1) - i1_u = UBOUND(SrcLinTypeData%D,1) - i2_l = LBOUND(SrcLinTypeData%D,2) - i2_u = UBOUND(SrcLinTypeData%D,2) - IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN - ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%xd_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%D = SrcLinTypeData%D + DO i1 = LBOUND(SrcLinStateSaveData%xd_SrvD,1), UBOUND(SrcLinStateSaveData%xd_SrvD,1) + CALL SrvD_CopyDiscState( SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRotation,1) - i1_u = UBOUND(SrcLinTypeData%StateRotation,1) - i2_l = LBOUND(SrcLinTypeData%StateRotation,2) - i2_u = UBOUND(SrcLinTypeData%StateRotation,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN - ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%z_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation + DO i1 = LBOUND(SrcLinStateSaveData%z_SrvD,1), UBOUND(SrcLinStateSaveData%z_SrvD,1) + CALL SrvD_CopyConstrState( SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN - ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1), UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) + CALL SrvD_CopyOtherState( SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN - ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%u_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot + DO i1 = LBOUND(SrcLinStateSaveData%u_SrvD,1), UBOUND(SrcLinStateSaveData%u_SrvD,1) + CALL SrvD_CopyInput( SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN - ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_AD)) THEN + ALLOCATE(DstLinStateSaveData%x_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u + DO i1 = LBOUND(SrcLinStateSaveData%x_AD,1), UBOUND(SrcLinStateSaveData%x_AD,1) + CALL AD_CopyContState( SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN - ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%xd_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_AD)) THEN + ALLOCATE(DstLinStateSaveData%xd_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u + DO i1 = LBOUND(SrcLinStateSaveData%xd_AD,1), UBOUND(SrcLinStateSaveData%xd_AD,1) + CALL AD_CopyDiscState( SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN - ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%z_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_AD)) THEN + ALLOCATE(DstLinStateSaveData%z_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y + DO i1 = LBOUND(SrcLinStateSaveData%z_AD,1), UBOUND(SrcLinStateSaveData%z_AD,1) + CALL AD_CopyConstrState( SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN - ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_AD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_AD,1), UBOUND(SrcLinStateSaveData%OtherSt_AD,1) + CALL AD_CopyOtherState( SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN - ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%u_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_AD)) THEN + ALLOCATE(DstLinStateSaveData%u_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z + DO i1 = LBOUND(SrcLinStateSaveData%u_AD,1), UBOUND(SrcLinStateSaveData%u_AD,1) + CALL AD_CopyInput( SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin - DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx - DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs - END SUBROUTINE FAST_CopyLinType - - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(LinTypeData%Names_u)) THEN - DEALLOCATE(LinTypeData%Names_u) +IF (ALLOCATED(SrcLinStateSaveData%x_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%x_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IfW)) THEN + ALLOCATE(DstLinStateSaveData%x_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_IfW,1), UBOUND(SrcLinStateSaveData%x_IfW,1) + CALL InflowWind_CopyContState( SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_y)) THEN - DEALLOCATE(LinTypeData%Names_y) +IF (ALLOCATED(SrcLinStateSaveData%xd_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IfW)) THEN + ALLOCATE(DstLinStateSaveData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_IfW,1), UBOUND(SrcLinStateSaveData%xd_IfW,1) + CALL InflowWind_CopyDiscState( SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_x)) THEN - DEALLOCATE(LinTypeData%Names_x) +IF (ALLOCATED(SrcLinStateSaveData%z_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%z_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IfW)) THEN + ALLOCATE(DstLinStateSaveData%z_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_IfW,1), UBOUND(SrcLinStateSaveData%z_IfW,1) + CALL InflowWind_CopyConstrState( SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_xd)) THEN - DEALLOCATE(LinTypeData%Names_xd) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IfW)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1), UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) + CALL InflowWind_CopyOtherState( SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_z)) THEN - DEALLOCATE(LinTypeData%Names_z) +IF (ALLOCATED(SrcLinStateSaveData%u_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%u_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IfW)) THEN + ALLOCATE(DstLinStateSaveData%u_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_IfW,1), UBOUND(SrcLinStateSaveData%u_IfW,1) + CALL InflowWind_CopyInput( SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_u)) THEN - DEALLOCATE(LinTypeData%op_u) +IF (ALLOCATED(SrcLinStateSaveData%x_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SD)) THEN + ALLOCATE(DstLinStateSaveData%x_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_SD,1), UBOUND(SrcLinStateSaveData%x_SD,1) + CALL SD_CopyContState( SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_y)) THEN - DEALLOCATE(LinTypeData%op_y) +IF (ALLOCATED(SrcLinStateSaveData%xd_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SD)) THEN + ALLOCATE(DstLinStateSaveData%xd_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_SD,1), UBOUND(SrcLinStateSaveData%xd_SD,1) + CALL SD_CopyDiscState( SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_x)) THEN - DEALLOCATE(LinTypeData%op_x) +IF (ALLOCATED(SrcLinStateSaveData%z_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SD)) THEN + ALLOCATE(DstLinStateSaveData%z_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_SD,1), UBOUND(SrcLinStateSaveData%z_SD,1) + CALL SD_CopyConstrState( SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_dx)) THEN - DEALLOCATE(LinTypeData%op_dx) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SD,1), UBOUND(SrcLinStateSaveData%OtherSt_SD,1) + CALL SD_CopyOtherState( SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_xd)) THEN - DEALLOCATE(LinTypeData%op_xd) +IF (ALLOCATED(SrcLinStateSaveData%u_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SD)) THEN + ALLOCATE(DstLinStateSaveData%u_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_SD,1), UBOUND(SrcLinStateSaveData%u_SD,1) + CALL SD_CopyInput( SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_z)) THEN - DEALLOCATE(LinTypeData%op_z) +IF (ALLOCATED(SrcLinStateSaveData%x_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1), UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) + CALL ExtPtfm_CopyContState( SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Use_u)) THEN - DEALLOCATE(LinTypeData%Use_u) +IF (ALLOCATED(SrcLinStateSaveData%xd_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1), UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) + CALL ExtPtfm_CopyDiscState( SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Use_y)) THEN - DEALLOCATE(LinTypeData%Use_y) +IF (ALLOCATED(SrcLinStateSaveData%z_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1), UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) + CALL ExtPtfm_CopyConstrState( SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%A)) THEN - DEALLOCATE(LinTypeData%A) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) + CALL ExtPtfm_CopyOtherState( SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%B)) THEN - DEALLOCATE(LinTypeData%B) +IF (ALLOCATED(SrcLinStateSaveData%u_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1), UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) + CALL ExtPtfm_CopyInput( SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%C)) THEN - DEALLOCATE(LinTypeData%C) +IF (ALLOCATED(SrcLinStateSaveData%x_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_HD)) THEN + ALLOCATE(DstLinStateSaveData%x_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_HD,1), UBOUND(SrcLinStateSaveData%x_HD,1) + CALL HydroDyn_CopyContState( SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%D)) THEN - DEALLOCATE(LinTypeData%D) +IF (ALLOCATED(SrcLinStateSaveData%xd_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_HD)) THEN + ALLOCATE(DstLinStateSaveData%xd_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_HD,1), UBOUND(SrcLinStateSaveData%xd_HD,1) + CALL HydroDyn_CopyDiscState( SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%StateRotation)) THEN - DEALLOCATE(LinTypeData%StateRotation) +IF (ALLOCATED(SrcLinStateSaveData%z_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_HD)) THEN + ALLOCATE(DstLinStateSaveData%z_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_HD,1), UBOUND(SrcLinStateSaveData%z_HD,1) + CALL HydroDyn_CopyConstrState( SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%StateRel_x)) THEN - DEALLOCATE(LinTypeData%StateRel_x) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_HD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_HD,1), UBOUND(SrcLinStateSaveData%OtherSt_HD,1) + CALL HydroDyn_CopyOtherState( SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN - DEALLOCATE(LinTypeData%StateRel_xdot) +IF (ALLOCATED(SrcLinStateSaveData%u_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_HD)) THEN + ALLOCATE(DstLinStateSaveData%u_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_HD,1), UBOUND(SrcLinStateSaveData%u_HD,1) + CALL HydroDyn_CopyInput( SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN - DEALLOCATE(LinTypeData%IsLoad_u) +IF (ALLOCATED(SrcLinStateSaveData%x_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%x_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceF)) THEN + ALLOCATE(DstLinStateSaveData%x_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_IceF,1), UBOUND(SrcLinStateSaveData%x_IceF,1) + CALL IceFloe_CopyContState( SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN - DEALLOCATE(LinTypeData%RotFrame_u) +IF (ALLOCATED(SrcLinStateSaveData%xd_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceF)) THEN + ALLOCATE(DstLinStateSaveData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_IceF,1), UBOUND(SrcLinStateSaveData%xd_IceF,1) + CALL IceFloe_CopyDiscState( SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN - DEALLOCATE(LinTypeData%RotFrame_y) +IF (ALLOCATED(SrcLinStateSaveData%z_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%z_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceF)) THEN + ALLOCATE(DstLinStateSaveData%z_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_IceF,1), UBOUND(SrcLinStateSaveData%z_IceF,1) + CALL IceFloe_CopyConstrState( SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN - DEALLOCATE(LinTypeData%RotFrame_x) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceF)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1), UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) + CALL IceFloe_CopyOtherState( SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN - DEALLOCATE(LinTypeData%RotFrame_z) +IF (ALLOCATED(SrcLinStateSaveData%u_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%u_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceF)) THEN + ALLOCATE(DstLinStateSaveData%u_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_IceF,1), UBOUND(SrcLinStateSaveData%u_IceF,1) + CALL IceFloe_CopyInput( SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_DestroyLinType - - SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Names_u allocated yes/no - IF ( ALLOCATED(InData%Names_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u +IF (ALLOCATED(SrcLinStateSaveData%x_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%x_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MAP)) THEN + ALLOCATE(DstLinStateSaveData%x_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no - IF ( ALLOCATED(InData%Names_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y + DO i1 = LBOUND(SrcLinStateSaveData%x_MAP,1), UBOUND(SrcLinStateSaveData%x_MAP,1) + CALL MAP_CopyContState( SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%xd_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MAP)) THEN + ALLOCATE(DstLinStateSaveData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no - IF ( ALLOCATED(InData%Names_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x + DO i1 = LBOUND(SrcLinStateSaveData%xd_MAP,1), UBOUND(SrcLinStateSaveData%xd_MAP,1) + CALL MAP_CopyDiscState( SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%z_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%z_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MAP)) THEN + ALLOCATE(DstLinStateSaveData%z_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no - IF ( ALLOCATED(InData%Names_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd + DO i1 = LBOUND(SrcLinStateSaveData%z_MAP,1), UBOUND(SrcLinStateSaveData%z_MAP,1) + CALL MAP_CopyConstrState( SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%u_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%u_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MAP)) THEN + ALLOCATE(DstLinStateSaveData%u_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no - IF ( ALLOCATED(InData%Names_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z + DO i1 = LBOUND(SrcLinStateSaveData%u_MAP,1), UBOUND(SrcLinStateSaveData%u_MAP,1) + CALL MAP_CopyInput( SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%x_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%x_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no - IF ( ALLOCATED(InData%op_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u + DO i1 = LBOUND(SrcLinStateSaveData%x_FEAM,1), UBOUND(SrcLinStateSaveData%x_FEAM,1) + CALL FEAM_CopyContState( SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%xd_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no - IF ( ALLOCATED(InData%op_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y + DO i1 = LBOUND(SrcLinStateSaveData%xd_FEAM,1), UBOUND(SrcLinStateSaveData%xd_FEAM,1) + CALL FEAM_CopyDiscState( SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%z_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%z_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no - IF ( ALLOCATED(InData%op_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x + DO i1 = LBOUND(SrcLinStateSaveData%z_FEAM,1), UBOUND(SrcLinStateSaveData%z_FEAM,1) + CALL FEAM_CopyConstrState( SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no - IF ( ALLOCATED(InData%op_dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1), UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) + CALL FEAM_CopyOtherState( SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%u_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%u_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no - IF ( ALLOCATED(InData%op_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd + DO i1 = LBOUND(SrcLinStateSaveData%u_FEAM,1), UBOUND(SrcLinStateSaveData%u_FEAM,1) + CALL FEAM_CopyInput( SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%x_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MD)) THEN + ALLOCATE(DstLinStateSaveData%x_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no - IF ( ALLOCATED(InData%op_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z + DO i1 = LBOUND(SrcLinStateSaveData%x_MD,1), UBOUND(SrcLinStateSaveData%x_MD,1) + CALL MD_CopyContState( SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%xd_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MD)) THEN + ALLOCATE(DstLinStateSaveData%xd_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no - IF ( ALLOCATED(InData%Use_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u + DO i1 = LBOUND(SrcLinStateSaveData%xd_MD,1), UBOUND(SrcLinStateSaveData%xd_MD,1) + CALL MD_CopyDiscState( SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%z_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MD)) THEN + ALLOCATE(DstLinStateSaveData%z_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no - IF ( ALLOCATED(InData%Use_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y + DO i1 = LBOUND(SrcLinStateSaveData%z_MD,1), UBOUND(SrcLinStateSaveData%z_MD,1) + CALL MD_CopyConstrState( SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_MD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%A) ! A + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_MD,1), UBOUND(SrcLinStateSaveData%OtherSt_MD,1) + CALL MD_CopyOtherState( SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%u_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MD)) THEN + ALLOCATE(DstLinStateSaveData%u_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! D allocated yes/no - IF ( ALLOCATED(InData%D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%D) ! D - END IF - Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no - IF ( ALLOCATED(InData%StateRotation) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no - IF ( ALLOCATED(InData%StateRel_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no - IF ( ALLOCATED(InData%StateRel_xdot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_z allocated yes/no - IF ( ALLOCATED(InData%RotFrame_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z - END IF - Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin - Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx - Int_BufSz = Int_BufSz + 1 ! NumOutputs - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + DO i1 = LBOUND(SrcLinStateSaveData%u_MD,1), UBOUND(SrcLinStateSaveData%u_MD,1) + CALL MD_CopyInput( SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE FAST_CopyLinStateSave - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) + TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinStateSave' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +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 ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%x_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%xd_IceD,2), UBOUND(LinStateSaveData%xd_IceD,2) +DO i1 = LBOUND(LinStateSaveData%xd_IceD,1), UBOUND(LinStateSaveData%xd_IceD,1) + CALL IceD_DestroyDiscState( LinStateSaveData%xd_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%xd_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%z_IceD,2), UBOUND(LinStateSaveData%z_IceD,2) +DO i1 = LBOUND(LinStateSaveData%z_IceD,1), UBOUND(LinStateSaveData%z_IceD,1) + CALL IceD_DestroyConstrState( LinStateSaveData%z_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%z_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%OtherSt_IceD,2), UBOUND(LinStateSaveData%OtherSt_IceD,2) +DO i1 = LBOUND(LinStateSaveData%OtherSt_IceD,1), UBOUND(LinStateSaveData%OtherSt_IceD,1) + CALL IceD_DestroyOtherState( LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%u_IceD,2), UBOUND(LinStateSaveData%u_IceD,2) +DO i1 = LBOUND(LinStateSaveData%u_IceD,1), UBOUND(LinStateSaveData%u_IceD,1) + CALL IceD_DestroyInput( LinStateSaveData%u_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%u_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%x_BD,2), UBOUND(LinStateSaveData%x_BD,2) +DO i1 = LBOUND(LinStateSaveData%x_BD,1), UBOUND(LinStateSaveData%x_BD,1) + CALL BD_DestroyContState( LinStateSaveData%x_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%x_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%xd_BD,2), UBOUND(LinStateSaveData%xd_BD,2) +DO i1 = LBOUND(LinStateSaveData%xd_BD,1), UBOUND(LinStateSaveData%xd_BD,1) + CALL BD_DestroyDiscState( LinStateSaveData%xd_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%xd_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%z_BD,2), UBOUND(LinStateSaveData%z_BD,2) +DO i1 = LBOUND(LinStateSaveData%z_BD,1), UBOUND(LinStateSaveData%z_BD,1) + CALL BD_DestroyConstrState( LinStateSaveData%z_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%z_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%OtherSt_BD,2), UBOUND(LinStateSaveData%OtherSt_BD,2) +DO i1 = LBOUND(LinStateSaveData%OtherSt_BD,1), UBOUND(LinStateSaveData%OtherSt_BD,1) + CALL BD_DestroyOtherState( LinStateSaveData%OtherSt_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%u_BD,2), UBOUND(LinStateSaveData%u_BD,2) +DO i1 = LBOUND(LinStateSaveData%u_BD,1), UBOUND(LinStateSaveData%u_BD,1) + CALL BD_DestroyInput( LinStateSaveData%u_BD(i1,i2), ErrStat, ErrMsg ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +ENDDO + DEALLOCATE(LinStateSaveData%u_MD) +ENDIF + END SUBROUTINE FAST_DestroyLinStateSave - IF ( .NOT. ALLOCATED(InData%Names_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE FAST_PackLinStateSave( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_LinStateSave), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinStateSave' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) - DO I = 1, LEN(InData%Names_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - IF ( .NOT. ALLOCATED(InData%Names_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) - Int_Xferred = Int_Xferred + 2 + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x_IceD allocated yes/no + IF ( ALLOCATED(InData%x_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x_IceD upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) + DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) + Int_BufSz = Int_BufSz + 3 ! x_IceD: size of buffers for each call to pack subtype + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) - DO I = 1, LEN(InData%Names_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! x_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Names_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_IceD allocated yes/no + IF ( ALLOCATED(InData%xd_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) + DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) + Int_BufSz = Int_BufSz + 3 ! xd_IceD: size of buffers for each call to pack subtype + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) - DO I = 1, LEN(InData%Names_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! xd_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_IceD allocated yes/no + IF ( ALLOCATED(InData%z_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) + DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) + Int_BufSz = Int_BufSz + 3 ! z_IceD: size of buffers for each call to pack subtype + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) - DO I = 1, LEN(InData%Names_xd) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! z_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_IceD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) + DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_IceD: size of buffers for each call to pack subtype + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) - DO I = 1, LEN(InData%Names_z) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_IceD allocated yes/no + IF ( ALLOCATED(InData%u_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! u_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) + DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) + Int_BufSz = Int_BufSz + 3 ! u_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_u))-1 ) = PACK(InData%op_u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_u) + IF(ALLOCATED(Re_Buf)) THEN ! u_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! x_BD allocated yes/no + IF ( ALLOCATED(InData%x_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) + DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) + Int_BufSz = Int_BufSz + 3 ! x_BD: size of buffers for each call to pack subtype + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_y)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_y))-1 ) = PACK(InData%op_y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_y) + IF(ALLOCATED(Re_Buf)) THEN ! x_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_BD allocated yes/no + IF ( ALLOCATED(InData%xd_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) + DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) + Int_BufSz = Int_BufSz + 3 ! xd_BD: size of buffers for each call to pack subtype + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_x))-1 ) = PACK(InData%op_x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_x) + IF(ALLOCATED(Re_Buf)) THEN ! xd_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_BD allocated yes/no + IF ( ALLOCATED(InData%z_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) + DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) + Int_BufSz = Int_BufSz + 3 ! z_BD: size of buffers for each call to pack subtype + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_dx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_dx))-1 ) = PACK(InData%op_dx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_dx) + IF(ALLOCATED(Re_Buf)) THEN ! z_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_BD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) + DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_BD: size of buffers for each call to pack subtype + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_xd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_xd))-1 ) = PACK(InData%op_xd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_xd) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_BD allocated yes/no + IF ( ALLOCATED(InData%u_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! u_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) + DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) + Int_BufSz = Int_BufSz + 3 ! u_BD: size of buffers for each call to pack subtype + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_z)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_z))-1 ) = PACK(InData%op_z,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_z) + IF(ALLOCATED(Re_Buf)) THEN ! u_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Use_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! x_ED allocated yes/no + IF ( ALLOCATED(InData%x_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) + Int_BufSz = Int_BufSz + 3 ! x_ED: size of buffers for each call to pack subtype + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%Use_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%Use_u)-1 ) = TRANSFER(PACK( InData%Use_u ,.TRUE.), IntKiBuf(1), SIZE(InData%Use_u)) - Int_Xferred = Int_Xferred + SIZE(InData%Use_u) + IF(ALLOCATED(Re_Buf)) THEN ! x_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%Use_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_ED allocated yes/no + IF ( ALLOCATED(InData%xd_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) + Int_BufSz = Int_BufSz + 3 ! xd_ED: size of buffers for each call to pack subtype + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%Use_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%Use_y)-1 ) = TRANSFER(PACK( InData%Use_y ,.TRUE.), IntKiBuf(1), SIZE(InData%Use_y)) - Int_Xferred = Int_Xferred + SIZE(InData%Use_y) + IF(ALLOCATED(Re_Buf)) THEN ! xd_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_ED allocated yes/no + IF ( ALLOCATED(InData%z_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) + Int_BufSz = Int_BufSz + 3 ! z_ED: size of buffers for each call to pack subtype + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%A)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%A) + IF(ALLOCATED(Re_Buf)) THEN ! z_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! OtherSt_ED allocated yes/no + IF ( ALLOCATED(InData%OtherSt_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_ED: size of buffers for each call to pack subtype + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%B)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%B) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_ED allocated yes/no + IF ( ALLOCATED(InData%u_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) + Int_BufSz = Int_BufSz + 3 ! u_ED: size of buffers for each call to pack subtype + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%C)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%C) + IF(ALLOCATED(Re_Buf)) THEN ! u_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! x_SrvD allocated yes/no + IF ( ALLOCATED(InData%x_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! x_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%D)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%D))-1 ) = PACK(InData%D,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%D) + IF(ALLOCATED(Re_Buf)) THEN ! x_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_SrvD allocated yes/no + IF ( ALLOCATED(InData%xd_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! xd_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%StateRotation)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRotation))-1 ) = PACK(InData%StateRotation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRotation) + IF(ALLOCATED(Re_Buf)) THEN ! xd_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%StateRel_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_SrvD allocated yes/no + IF ( ALLOCATED(InData%z_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! z_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%StateRel_x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRel_x))-1 ) = PACK(InData%StateRel_x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRel_x) + IF(ALLOCATED(Re_Buf)) THEN ! z_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_SrvD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%StateRel_xdot)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRel_xdot))-1 ) = PACK(InData%StateRel_xdot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRel_xdot) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! u_SrvD allocated yes/no + IF ( ALLOCATED(InData%u_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! u_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + IF(ALLOCATED(Re_Buf)) THEN ! u_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! x_AD allocated yes/no + IF ( ALLOCATED(InData%x_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) + Int_BufSz = Int_BufSz + 3 ! x_AD: size of buffers for each call to pack subtype + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + IF(ALLOCATED(Re_Buf)) THEN ! x_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! xd_AD allocated yes/no + IF ( ALLOCATED(InData%xd_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) + Int_BufSz = Int_BufSz + 3 ! xd_AD: size of buffers for each call to pack subtype + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + IF(ALLOCATED(Re_Buf)) THEN ! xd_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! z_AD allocated yes/no + IF ( ALLOCATED(InData%z_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) + Int_BufSz = Int_BufSz + 3 ! z_AD: size of buffers for each call to pack subtype + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + IF(ALLOCATED(Re_Buf)) THEN ! z_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_AD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_AD: size of buffers for each call to pack subtype + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_z)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_z)-1 ) = TRANSFER(PACK( InData%RotFrame_z ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_z)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_z) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SizeLin))-1 ) = PACK(InData%SizeLin,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SizeLin) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LinStartIndx))-1 ) = PACK(InData%LinStartIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LinStartIndx) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutputs - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackLinType + Int_BufSz = Int_BufSz + 1 ! u_AD allocated yes/no + IF ( ALLOCATED(InData%u_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) + Int_BufSz = Int_BufSz + 3 ! u_AD: size of buffers for each call to pack subtype + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_u)) DEALLOCATE(OutData%Names_u) - ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) - DO I = 1, LEN(OutData%Names_u) - OutData%Names_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + IF(ALLOCATED(Re_Buf)) THEN ! u_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_y)) DEALLOCATE(OutData%Names_y) - ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) - DO I = 1, LEN(OutData%Names_y) - OutData%Names_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! x_IfW allocated yes/no + IF ( ALLOCATED(InData%x_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) + Int_BufSz = Int_BufSz + 3 ! x_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_x)) DEALLOCATE(OutData%Names_x) - ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) - DO I = 1, LEN(OutData%Names_x) - OutData%Names_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! xd_IfW allocated yes/no + IF ( ALLOCATED(InData%xd_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) + Int_BufSz = Int_BufSz + 3 ! xd_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_xd)) DEALLOCATE(OutData%Names_xd) - ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) - DO I = 1, LEN(OutData%Names_xd) - OutData%Names_xd(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! z_IfW allocated yes/no + IF ( ALLOCATED(InData%z_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) + Int_BufSz = Int_BufSz + 3 ! z_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_z)) DEALLOCATE(OutData%Names_z) - ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) - DO I = 1, LEN(OutData%Names_z) - OutData%Names_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! OtherSt_IfW allocated yes/no + IF ( ALLOCATED(InData%OtherSt_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_u)) DEALLOCATE(OutData%op_u) - ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_u)>0) OutData%op_u = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_u))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_u) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_y)) DEALLOCATE(OutData%op_y) - ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_y)>0) OutData%op_y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_y) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_x)) DEALLOCATE(OutData%op_x) - ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_x)>0) OutData%op_x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_x) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_dx)) DEALLOCATE(OutData%op_dx) - ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_dx)>0) OutData%op_dx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_dx))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_dx) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_xd)) DEALLOCATE(OutData%op_xd) - ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_xd)>0) OutData%op_xd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_xd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_xd) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_z)) DEALLOCATE(OutData%op_z) - ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_z)>0) OutData%op_z = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_z))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_z) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Use_u)) DEALLOCATE(OutData%Use_u) - ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Use_u)>0) OutData%Use_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Use_u))-1 ), OutData%Use_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%Use_u) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Use_y)) DEALLOCATE(OutData%Use_y) - ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Use_y)>0) OutData%Use_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Use_y))-1 ), OutData%Use_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%Use_y) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) - 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 - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D)) DEALLOCATE(OutData%D) - ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D)>0) OutData%D = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%D))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%D) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRotation)) DEALLOCATE(OutData%StateRotation) - ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRotation)>0) OutData%StateRotation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRotation))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRotation) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRel_x)) DEALLOCATE(OutData%StateRel_x) - ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRel_x)>0) OutData%StateRel_x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRel_x))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRel_x) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) - ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRel_xdot)>0) OutData%StateRel_xdot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRel_xdot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRel_xdot) - DEALLOCATE(mask2) - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_z)) DEALLOCATE(OutData%RotFrame_z) - ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_z)>0) OutData%RotFrame_z = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_z))-1 ), OutData%RotFrame_z), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_z) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! u_IfW allocated yes/no + IF ( ALLOCATED(InData%u_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) + Int_BufSz = Int_BufSz + 3 ! u_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - i1_l = LBOUND(OutData%SizeLin,1) - i1_u = UBOUND(OutData%SizeLin,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SizeLin = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SizeLin))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SizeLin) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%LinStartIndx,1) - i1_u = UBOUND(OutData%LinStartIndx,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinStartIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LinStartIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LinStartIndx) - DEALLOCATE(mask1) - OutData%NumOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackLinType + Int_BufSz = Int_BufSz + 1 ! x_SD allocated yes/no + IF ( ALLOCATED(InData%x_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) + Int_BufSz = Int_BufSz + 3 ! x_SD: size of buffers for each call to pack subtype + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData - TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN - i1_l = LBOUND(SrcModLinTypeData%Instance,1) - i1_u = UBOUND(SrcModLinTypeData%Instance,1) - IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN - ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF(ALLOCATED(Re_Buf)) THEN ! x_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) - CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyModLinType + Int_BufSz = Int_BufSz + 1 ! xd_SD allocated yes/no + IF ( ALLOCATED(InData%xd_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) + Int_BufSz = Int_BufSz + 3 ! xd_SD: size of buffers for each call to pack subtype + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ModLinTypeData%Instance)) THEN -DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModLinTypeData%Instance) -ENDIF - END SUBROUTINE FAST_DestroyModLinType + IF(ALLOCATED(Re_Buf)) THEN ! xd_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_SD allocated yes/no + IF ( ALLOCATED(InData%z_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) + Int_BufSz = Int_BufSz + 3 ! z_SD: size of buffers for each call to pack subtype + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ModLinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF(ALLOCATED(Re_Buf)) THEN ! z_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_SD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_SD: size of buffers for each call to pack subtype + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Instance allocated yes/no - IF ( ALLOCATED(InData%Instance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_SD allocated yes/no + IF ( ALLOCATED(InData%u_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) + Int_BufSz = Int_BufSz + 3 ! u_SD: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Instance + IF(ALLOCATED(Re_Buf)) THEN ! u_SD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Instance + IF(ALLOCATED(Db_Buf)) THEN ! u_SD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Instance + IF(ALLOCATED(Int_Buf)) THEN ! u_SD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO END IF - IF ( Re_BufSz .GT. 0 ) THEN + Int_BufSz = Int_BufSz + 1 ! x_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%x_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! x_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%xd_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! xd_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%z_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! z_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%u_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_HD allocated yes/no + IF ( ALLOCATED(InData%x_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) + Int_BufSz = Int_BufSz + 3 ! x_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_HD allocated yes/no + IF ( ALLOCATED(InData%xd_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) + Int_BufSz = Int_BufSz + 3 ! xd_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_HD allocated yes/no + IF ( ALLOCATED(InData%z_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) + Int_BufSz = Int_BufSz + 3 ! z_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_HD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_HD allocated yes/no + IF ( ALLOCATED(InData%u_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) + Int_BufSz = Int_BufSz + 3 ! u_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_IceF allocated yes/no + IF ( ALLOCATED(InData%x_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) + Int_BufSz = Int_BufSz + 3 ! x_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_IceF allocated yes/no + IF ( ALLOCATED(InData%xd_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) + Int_BufSz = Int_BufSz + 3 ! xd_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_IceF allocated yes/no + IF ( ALLOCATED(InData%z_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) + Int_BufSz = Int_BufSz + 3 ! z_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_IceF allocated yes/no + IF ( ALLOCATED(InData%OtherSt_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_IceF allocated yes/no + IF ( ALLOCATED(InData%u_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) + Int_BufSz = Int_BufSz + 3 ! u_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_MAP allocated yes/no + IF ( ALLOCATED(InData%x_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) + Int_BufSz = Int_BufSz + 3 ! x_MAP: size of buffers for each call to pack subtype + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_MAP allocated yes/no + IF ( ALLOCATED(InData%xd_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) + Int_BufSz = Int_BufSz + 3 ! xd_MAP: size of buffers for each call to pack subtype + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_MAP allocated yes/no + IF ( ALLOCATED(InData%z_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) + Int_BufSz = Int_BufSz + 3 ! z_MAP: size of buffers for each call to pack subtype + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_MAP allocated yes/no + IF ( ALLOCATED(InData%u_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) + Int_BufSz = Int_BufSz + 3 ! u_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_FEAM allocated yes/no + IF ( ALLOCATED(InData%x_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! x_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_FEAM allocated yes/no + IF ( ALLOCATED(InData%xd_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! xd_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_FEAM allocated yes/no + IF ( ALLOCATED(InData%z_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! z_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_FEAM allocated yes/no + IF ( ALLOCATED(InData%OtherSt_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_FEAM allocated yes/no + IF ( ALLOCATED(InData%u_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! u_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_MD allocated yes/no + IF ( ALLOCATED(InData%x_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) + Int_BufSz = Int_BufSz + 3 ! x_MD: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_MD allocated yes/no + IF ( ALLOCATED(InData%xd_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) + Int_BufSz = Int_BufSz + 3 ! xd_MD: size of buffers for each call to pack subtype + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_MD allocated yes/no + IF ( ALLOCATED(InData%z_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) + Int_BufSz = Int_BufSz + 3 ! z_MD: size of buffers for each call to pack subtype + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_MD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_MD: size of buffers for each call to pack subtype + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_MD allocated yes/no + IF ( ALLOCATED(InData%u_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) + Int_BufSz = Int_BufSz + 3 ! u_MD: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) @@ -3935,18 +5979,22 @@ SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%Instance) ) THEN + IF ( .NOT. ALLOCATED(InData%x_IceD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Instance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance + DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) + DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3975,245 +6023,208 @@ SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO END IF - END SUBROUTINE FAST_PackModLinType - - SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ModLinType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Instance not allocated + IF ( .NOT. ALLOCATED(InData%xd_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Instance)) DEALLOCATE(OutData%Instance) - ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) + DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FAST_UnPackModLinType - - SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData - TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) - CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed - DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth - END SUBROUTINE FAST_CopyLinFileType + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat, ErrMsg ) -ENDDO - CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyLinFileType + DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) + DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,2) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules + DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) + DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Modules - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Modules - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Modules - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) + DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Glue - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Glue - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Glue - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! Azimuth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) 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(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%x_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,2) + Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules + DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) + DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4242,7 +6253,24 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) + DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4270,460 +6298,323 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Azimuth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_PackLinFileType + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%Modules,1) - i1_u = UBOUND(OutData%Modules,1) - DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpackmodlintype( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules + DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) + DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) + DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_UnPackLinFileType + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(IN) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) + DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData -ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits -ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOutputFileType - - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - DEALLOCATE(OutputFileTypeData%ChannelUnits) -ENDIF -DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) -ENDDO - CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyOutputFileType - - SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF ( .NOT. ALLOCATED(InData%x_ED) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ED,1) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts - Int_BufSz = Int_BufSz + 1 ! UnOu - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! UnGra - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no - IF ( ALLOCATED(InData%ChannelNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no - IF ( ALLOCATED(InData%ChannelUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver + DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev - Int_BufSz = Int_BufSz + 1 ! VTK_count - Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ED,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TimeData)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TimeData))-1 ) = PACK(InData%TimeData,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TimeData) + DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN + IF ( .NOT. ALLOCATED(InData%z_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ED,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOutData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOutData))-1 ) = PACK(InData%AllOutData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOutData) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%numOuts))-1 ) = PACK(InData%numOuts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%numOuts) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnGra - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN + DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ED,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) - DO I = 1, LEN(InData%ChannelNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN + IF ( .NOT. ALLOCATED(InData%u_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) - DO I = 1, LEN(InData%ChannelUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver + DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4752,17 +6643,19 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) - DO I = 1, LEN(InData%Module_Abrev) - IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_count - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_LastWaveIndx - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + END IF + IF ( .NOT. ALLOCATED(InData%x_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SrvD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4790,861 +6683,512 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE FAST_PackOutputFileType - - SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOutputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TimeData)>0) OutData%TimeData = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TimeData))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TimeData) - DEALLOCATE(mask1) + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated + IF ( .NOT. ALLOCATED(InData%xd_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SrvD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AllOutData)>0) OutData%AllOutData = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOutData))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOutData) - DEALLOCATE(mask2) + + DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - OutData%n_Out = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%numOuts,1) - i1_u = UBOUND(OutData%numOuts,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%numOuts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%numOuts))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%numOuts) - DEALLOCATE(mask1) - OutData%UnOu = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnGra = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated + IF ( .NOT. ALLOCATED(InData%z_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SrvD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChannelNames)) DEALLOCATE(OutData%ChannelNames) - ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) - DO I = 1, LEN(OutData%ChannelNames) - OutData%ChannelNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + + DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelUnits not allocated + IF ( .NOT. ALLOCATED(InData%OtherSt_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SrvD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) - ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) - DO I = 1, LEN(OutData%ChannelUnits) - OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%Module_Abrev,1) - i1_u = UBOUND(OutData%Module_Abrev,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) - DO I = 1, LEN(OutData%Module_Abrev) - OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%VTK_count = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_LastWaveIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpacklinfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackOutputFileType - - SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData - TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%x,1) - i1_u = UBOUND(SrcIceDyn_DataData%x,1) - i2_l = LBOUND(SrcIceDyn_DataData%x,2) - i2_u = UBOUND(SrcIceDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN - ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) - DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) - CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%xd,1) - i1_u = UBOUND(SrcIceDyn_DataData%xd,1) - i2_l = LBOUND(SrcIceDyn_DataData%xd,2) - i2_u = UBOUND(SrcIceDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN - ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) - DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) - CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%z,1) - i1_u = UBOUND(SrcIceDyn_DataData%z,1) - i2_l = LBOUND(SrcIceDyn_DataData%z,2) - i2_u = UBOUND(SrcIceDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN - ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) - DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) - CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN - ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) - CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%p,1) - i1_u = UBOUND(SrcIceDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN - ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) - CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%u,1) - i1_u = UBOUND(SrcIceDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN - ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%y,1) - i1_u = UBOUND(SrcIceDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN - ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) - CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%m,1) - i1_u = UBOUND(SrcIceDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN - ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) - CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN - ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceDyn_Data - - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -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 ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%x) -ENDIF -IF (ALLOCATED(IceDyn_DataData%xd)) THEN -DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) -DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) - CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%xd) -ENDIF -IF (ALLOCATED(IceDyn_DataData%z)) THEN -DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) -DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) - CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%z) -ENDIF -IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) -DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) - CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat, ErrMsg ) -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 ) -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 ) -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 ) -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 ) -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 ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%Input) -ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceDyn_Data - - SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF ( .NOT. ALLOCATED(InData%u_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SrvD,1) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x + DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd + IF ( .NOT. ALLOCATED(InData%x_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + IF ( .NOT. ALLOCATED(InData%z_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p + IF ( .NOT. ALLOCATED(InData%OtherSt_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u + IF ( .NOT. ALLOCATED(InData%u_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! 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 + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y + IF ( .NOT. ALLOCATED(InData%x_IfW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IfW,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! 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 + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m + IF ( .NOT. ALLOCATED(InData%xd_IfW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IfW,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input + IF ( .NOT. ALLOCATED(InData%z_IfW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IfW,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! 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 + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_IfW) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IfW,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x + DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5673,24 +7217,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IF ( .NOT. ALLOCATED(InData%u_IfW) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IfW,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd + DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5719,24 +7258,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN + IF ( .NOT. ALLOCATED(InData%x_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SD,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z + DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5765,24 +7299,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SD,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5811,20 +7340,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%p) ) THEN + IF ( .NOT. ALLOCATED(InData%z_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p + DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5854,18 +7382,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%u) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u + DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5895,18 +7423,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN + IF ( .NOT. ALLOCATED(InData%u_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y + DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5936,18 +7464,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%m) ) THEN + IF ( .NOT. ALLOCATED(InData%x_ExtPtfm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m + DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5977,22 +7505,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_ExtPtfm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input + DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6021,1192 +7545,675 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%z_ExtPtfm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackIceDyn_Data + DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x + + DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + IF ( .NOT. ALLOCATED(InData%u_ExtPtfm) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd + + DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + IF ( .NOT. ALLOCATED(InData%x_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_HD,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z + + DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + IF ( .NOT. ALLOCATED(InData%xd_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt + + DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + IF ( .NOT. ALLOCATED(InData%z_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p + + DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated + IF ( .NOT. ALLOCATED(InData%OtherSt_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u + + DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + IF ( .NOT. ALLOCATED(InData%u_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y + + DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + IF ( .NOT. ALLOCATED(InData%x_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceF,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m + + DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( .NOT. ALLOCATED(InData%xd_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceF,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input + + DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( .NOT. ALLOCATED(InData%z_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceF,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + + DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceF,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask2, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask2) + + DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - END SUBROUTINE FAST_UnPackIceDyn_Data + IF ( .NOT. ALLOCATED(InData%u_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceF,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData - TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%x,1) - i1_u = UBOUND(SrcBeamDyn_DataData%x,1) - i2_l = LBOUND(SrcBeamDyn_DataData%x,2) - i2_u = UBOUND(SrcBeamDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN - ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) - CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) - i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) - i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) - i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN - ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%x_MAP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MAP,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) - CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%z,1) - i1_u = UBOUND(SrcBeamDyn_DataData%z,1) - i2_l = LBOUND(SrcBeamDyn_DataData%z,2) - i2_u = UBOUND(SrcBeamDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN - ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%xd_MAP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MAP,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) - CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN - ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%z_MAP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MAP,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) - CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%p,1) - i1_u = UBOUND(SrcBeamDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN - ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) - CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%u,1) - i1_u = UBOUND(SrcBeamDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN - ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN - ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%m,1) - i1_u = UBOUND(SrcBeamDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN - ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) - CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN - ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyBeamDyn_Data - - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -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 ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%x) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%xd)) THEN -DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) -DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) - CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%xd) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%z)) THEN -DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) -DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) - CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%z) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) -DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) - CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat, ErrMsg ) -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 ) -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 ) -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 ) -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 ) -ENDDO - DEALLOCATE(BeamDyn_DataData%m) -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 ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Input) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyBeamDyn_Data - - SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BeamDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackBeamDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN + IF ( .NOT. ALLOCATED(InData%u_MAP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MAP,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x + DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7235,24 +8242,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IF ( .NOT. ALLOCATED(InData%x_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd + DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7281,24 +8283,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z + DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7327,24 +8324,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IF ( .NOT. ALLOCATED(InData%z_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7373,20 +8365,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%p) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p + DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7416,18 +8407,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%u) ) THEN + IF ( .NOT. ALLOCATED(InData%u_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u + DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7457,18 +8448,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN + IF ( .NOT. ALLOCATED(InData%x_MD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y + DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7498,18 +8489,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%m) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_MD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m + DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7539,22 +8530,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IF ( .NOT. ALLOCATED(InData%z_MD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MD,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input + DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7583,31 +8570,96 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_MD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_MD,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) + + DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_MD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - END SUBROUTINE FAST_PackBeamDyn_Data + END SUBROUTINE FAST_PackLinStateSave - SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackLinStateSave( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BeamDyn_Data), INTENT(INOUT) :: OutData + TYPE(FAST_LinStateSave), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -7616,17 +8668,11 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackBeamDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinStateSave' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -7637,7 +8683,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7647,14 +8693,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%x_IceD)) DEALLOCATE(OutData%x_IceD) + ALLOCATE(OutData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + DO i2 = LBOUND(OutData%x_IceD,2), UBOUND(OutData%x_IceD,2) + DO i1 = LBOUND(OutData%x_IceD,1), UBOUND(OutData%x_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7688,7 +8734,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x + CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! x_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7698,7 +8744,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7708,14 +8754,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_IceD)) DEALLOCATE(OutData%xd_IceD) + ALLOCATE(OutData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + DO i2 = LBOUND(OutData%xd_IceD,2), UBOUND(OutData%xd_IceD,2) + DO i1 = LBOUND(OutData%xd_IceD,1), UBOUND(OutData%xd_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7749,7 +8795,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd + CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7759,7 +8805,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7769,14 +8815,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_IceD)) DEALLOCATE(OutData%z_IceD) + ALLOCATE(OutData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + DO i2 = LBOUND(OutData%z_IceD,2), UBOUND(OutData%z_IceD,2) + DO i1 = LBOUND(OutData%z_IceD,1), UBOUND(OutData%z_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7810,7 +8856,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z + CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! z_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7820,7 +8866,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7830,14 +8876,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OtherSt_IceD)) DEALLOCATE(OutData%OtherSt_IceD) + ALLOCATE(OutData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + DO i2 = LBOUND(OutData%OtherSt_IceD,2), UBOUND(OutData%OtherSt_IceD,2) + DO i1 = LBOUND(OutData%OtherSt_IceD,1), UBOUND(OutData%OtherSt_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7871,7 +8917,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt + CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7881,76 +8927,24 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + 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),STAT=ErrStat2) + IF (ALLOCATED(OutData%u_IceD)) DEALLOCATE(OutData%u_IceD) + ALLOCATE(OutData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + DO i2 = LBOUND(OutData%u_IceD,2), UBOUND(OutData%u_IceD,2) + DO i1 = LBOUND(OutData%u_IceD,1), UBOUND(OutData%u_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7984,7 +8978,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! u_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7992,77 +8986,26 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(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%x_BD)) DEALLOCATE(OutData%x_BD) + ALLOCATE(OutData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) + DO i2 = LBOUND(OutData%x_BD,2), UBOUND(OutData%x_BD,2) + DO i1 = LBOUND(OutData%x_BD,1), UBOUND(OutData%x_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8096,7 +9039,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m + CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) ! x_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8104,8 +9047,9 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -8115,14 +9059,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_BD)) DEALLOCATE(OutData%xd_BD) + ALLOCATE(OutData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i2 = LBOUND(OutData%xd_BD,2), UBOUND(OutData%xd_BD,2) + DO i1 = LBOUND(OutData%xd_BD,1), UBOUND(OutData%xd_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8156,7 +9100,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input + CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8166,7 +9110,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -8176,782 +9120,361 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_BD)) DEALLOCATE(OutData%z_BD) + ALLOCATE(OutData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask2, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask2) - END IF - END SUBROUTINE FAST_UnPackBeamDyn_Data + DO i2 = LBOUND(OutData%z_BD,2), UBOUND(OutData%z_BD,2) + DO i1 = LBOUND(OutData%z_BD,1), UBOUND(OutData%z_BD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) ! z_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData - TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) - CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) - CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) - CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) - CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN - ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) - CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN - ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_BD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_BD)) DEALLOCATE(OutData%OtherSt_BD) + ALLOCATE(OutData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - END IF - DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyElastoDyn_Data - - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) - CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) - CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) - CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Output) -ENDIF -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 ) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyElastoDyn_Data - - SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElastoDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackElastoDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i2 = LBOUND(OutData%OtherSt_BD,2), UBOUND(OutData%OtherSt_BD,2) + DO i1 = LBOUND(OutData%OtherSt_BD,1), UBOUND(OutData%OtherSt_BD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_BD)) DEALLOCATE(OutData%u_BD) + ALLOCATE(OutData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%u_BD,2), UBOUND(OutData%u_BD,2) + DO i1 = LBOUND(OutData%u_BD,1), UBOUND(OutData%u_BD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) ! u_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_ED)) DEALLOCATE(OutData%x_ED) + ALLOCATE(OutData%x_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_ED,1), UBOUND(OutData%x_ED,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ED(i1), ErrStat2, ErrMsg2 ) ! x_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_ED)) DEALLOCATE(OutData%xd_ED) + ALLOCATE(OutData%xd_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_ED,1), UBOUND(OutData%xd_ED,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ED(i1), ErrStat2, ErrMsg2 ) ! xd_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_ED)) DEALLOCATE(OutData%z_ED) + ALLOCATE(OutData%z_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_ED,1), UBOUND(OutData%z_ED,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ED(i1), ErrStat2, ErrMsg2 ) ! z_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IF(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 ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_ED not allocated 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) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackElastoDyn_Data - - SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackElastoDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%OtherSt_ED)) DEALLOCATE(OutData%OtherSt_ED) + ALLOCATE(OutData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_ED,1), UBOUND(OutData%OtherSt_ED,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8985,7 +9508,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8993,9 +9516,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_ED)) DEALLOCATE(OutData%u_ED) + ALLOCATE(OutData%u_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_ED,1), UBOUND(OutData%u_ED,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9029,7 +9564,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ED(i1), ErrStat2, ErrMsg2 ) ! u_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9037,9 +9572,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_SrvD)) DEALLOCATE(OutData%x_SrvD) + ALLOCATE(OutData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_SrvD,1), UBOUND(OutData%x_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9073,7 +9620,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SrvD(i1), ErrStat2, ErrMsg2 ) ! x_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9081,11 +9628,23 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_SrvD)) DEALLOCATE(OutData%xd_SrvD) + ALLOCATE(OutData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_SrvD,1), UBOUND(OutData%xd_SrvD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN @@ -9117,7 +9676,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) ! xd_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9125,6 +9684,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_SrvD)) DEALLOCATE(OutData%z_SrvD) + ALLOCATE(OutData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_SrvD,1), UBOUND(OutData%z_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9158,13 +9732,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SrvD(i1), ErrStat2, ErrMsg2 ) ! z_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_SrvD)) DEALLOCATE(OutData%OtherSt_SrvD) + ALLOCATE(OutData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_SrvD,1), UBOUND(OutData%OtherSt_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9198,13 +9788,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_SrvD)) DEALLOCATE(OutData%u_SrvD) + ALLOCATE(OutData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_SrvD,1), UBOUND(OutData%u_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9238,13 +9844,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SrvD(i1), ErrStat2, ErrMsg2 ) ! u_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_AD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_AD)) DEALLOCATE(OutData%x_AD) + ALLOCATE(OutData%x_AD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_AD,1), UBOUND(OutData%x_AD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9278,27 +9900,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_AD(i1), ErrStat2, ErrMsg2 ) ! x_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_AD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_AD)) DEALLOCATE(OutData%xd_AD) + ALLOCATE(OutData%xd_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + DO i1 = LBOUND(OutData%xd_AD,1), UBOUND(OutData%xd_AD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9332,7 +9956,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_AD(i1), ErrStat2, ErrMsg2 ) ! xd_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9341,20 +9965,20 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_AD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_AD)) DEALLOCATE(OutData%z_AD) + ALLOCATE(OutData%z_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%z_AD,1), UBOUND(OutData%z_AD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9388,7 +10012,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_AD(i1), ErrStat2, ErrMsg2 ) ! z_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9397,703 +10021,300 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_AD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OtherSt_AD)) DEALLOCATE(OutData%OtherSt_AD) + ALLOCATE(OutData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackElastoDyn_Data - - SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData - TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) - CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) - CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) - CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) - CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN - ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyServoDyn_Data - - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) - CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) - CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) - CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(ServoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyServoDyn_Data - - SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ServoDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackServoDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i1 = LBOUND(OutData%OtherSt_AD,1), UBOUND(OutData%OtherSt_AD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_AD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_AD)) DEALLOCATE(OutData%u_AD) + ALLOCATE(OutData%u_AD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_AD,1), UBOUND(OutData%u_AD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_AD(i1), ErrStat2, ErrMsg2 ) ! u_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_IfW)) DEALLOCATE(OutData%x_IfW) + ALLOCATE(OutData%x_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_IfW,1), UBOUND(OutData%x_IfW,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IfW(i1), ErrStat2, ErrMsg2 ) ! x_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_IfW)) DEALLOCATE(OutData%xd_IfW) + ALLOCATE(OutData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_IfW,1), UBOUND(OutData%xd_IfW,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IfW(i1), ErrStat2, ErrMsg2 ) ! xd_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_IfW)) DEALLOCATE(OutData%z_IfW) + ALLOCATE(OutData%z_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_IfW,1), UBOUND(OutData%z_IfW,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IfW(i1), ErrStat2, ErrMsg2 ) ! z_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IF(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 ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IfW not allocated 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) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackServoDyn_Data - - SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ServoDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackServoDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%OtherSt_IfW)) DEALLOCATE(OutData%OtherSt_IfW) + ALLOCATE(OutData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_IfW,1), UBOUND(OutData%OtherSt_IfW,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10127,7 +10348,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10135,9 +10356,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_IfW)) DEALLOCATE(OutData%u_IfW) + ALLOCATE(OutData%u_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_IfW,1), UBOUND(OutData%u_IfW,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10171,7 +10404,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW(i1), ErrStat2, ErrMsg2 ) ! u_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10179,9 +10412,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_SD)) DEALLOCATE(OutData%x_SD) + ALLOCATE(OutData%x_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_SD,1), UBOUND(OutData%x_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10215,7 +10460,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SD(i1), ErrStat2, ErrMsg2 ) ! x_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10223,9 +10468,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_SD)) DEALLOCATE(OutData%xd_SD) + ALLOCATE(OutData%xd_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_SD,1), UBOUND(OutData%xd_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10259,7 +10516,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SD(i1), ErrStat2, ErrMsg2 ) ! xd_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10267,6 +10524,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_SD)) DEALLOCATE(OutData%z_SD) + ALLOCATE(OutData%z_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_SD,1), UBOUND(OutData%z_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10300,13 +10572,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SD(i1), ErrStat2, ErrMsg2 ) ! z_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_SD)) DEALLOCATE(OutData%OtherSt_SD) + ALLOCATE(OutData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_SD,1), UBOUND(OutData%OtherSt_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10340,13 +10628,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_SD)) DEALLOCATE(OutData%u_SD) + ALLOCATE(OutData%u_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_SD,1), UBOUND(OutData%u_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10380,13 +10684,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SD(i1), ErrStat2, ErrMsg2 ) ! u_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ExtPtfm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_ExtPtfm)) DEALLOCATE(OutData%x_ExtPtfm) + ALLOCATE(OutData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_ExtPtfm,1), UBOUND(OutData%x_ExtPtfm,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10420,27 +10740,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! x_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_ExtPtfm not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_ExtPtfm)) DEALLOCATE(OutData%xd_ExtPtfm) + ALLOCATE(OutData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%xd_ExtPtfm,1), UBOUND(OutData%xd_ExtPtfm,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10474,7 +10796,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! xd_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10483,703 +10805,412 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_ExtPtfm not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_ExtPtfm)) DEALLOCATE(OutData%z_ExtPtfm) + ALLOCATE(OutData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackServoDyn_Data - - SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData - TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) - CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) - CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) - CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) - CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn14_Data - - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) - CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) - CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) - CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(AeroDyn14_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn14_Data - - SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn14_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn14_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i1 = LBOUND(OutData%z_ExtPtfm,1), UBOUND(OutData%z_ExtPtfm,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! z_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) 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 + 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(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_ExtPtfm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_ExtPtfm)) DEALLOCATE(OutData%OtherSt_ExtPtfm) + ALLOCATE(OutData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_ExtPtfm,1), UBOUND(OutData%OtherSt_ExtPtfm,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ExtPtfm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_ExtPtfm)) DEALLOCATE(OutData%u_ExtPtfm) + ALLOCATE(OutData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_ExtPtfm,1), UBOUND(OutData%u_ExtPtfm,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! u_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_HD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_HD)) DEALLOCATE(OutData%x_HD) + ALLOCATE(OutData%x_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_HD,1), UBOUND(OutData%x_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_HD(i1), ErrStat2, ErrMsg2 ) ! x_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_HD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_HD)) DEALLOCATE(OutData%xd_HD) + ALLOCATE(OutData%xd_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_HD,1), UBOUND(OutData%xd_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_HD(i1), ErrStat2, ErrMsg2 ) ! xd_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_HD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_HD)) DEALLOCATE(OutData%z_HD) + ALLOCATE(OutData%z_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_HD,1), UBOUND(OutData%z_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_HD(i1), ErrStat2, ErrMsg2 ) ! z_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_HD not allocated 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) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + IF (ALLOCATED(OutData%OtherSt_HD)) DEALLOCATE(OutData%OtherSt_HD) + ALLOCATE(OutData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_HD,1), UBOUND(OutData%OtherSt_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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(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 ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_HD not allocated 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) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackAeroDyn14_Data - - SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn14_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%u_HD)) DEALLOCATE(OutData%u_HD) + ALLOCATE(OutData%u_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_HD,1), UBOUND(OutData%u_HD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11213,7 +11244,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_HD(i1), ErrStat2, ErrMsg2 ) ! u_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11221,9 +11252,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_IceF)) DEALLOCATE(OutData%x_IceF) + ALLOCATE(OutData%x_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_IceF,1), UBOUND(OutData%x_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11257,7 +11300,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceF(i1), ErrStat2, ErrMsg2 ) ! x_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11265,9 +11308,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_IceF)) DEALLOCATE(OutData%xd_IceF) + ALLOCATE(OutData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_IceF,1), UBOUND(OutData%xd_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11301,7 +11356,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceF(i1), ErrStat2, ErrMsg2 ) ! xd_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11309,9 +11364,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_IceF)) DEALLOCATE(OutData%z_IceF) + ALLOCATE(OutData%z_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_IceF,1), UBOUND(OutData%z_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11345,7 +11412,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceF(i1), ErrStat2, ErrMsg2 ) ! z_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11353,6 +11420,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_IceF)) DEALLOCATE(OutData%OtherSt_IceF) + ALLOCATE(OutData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_IceF,1), UBOUND(OutData%OtherSt_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11386,13 +11468,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_IceF)) DEALLOCATE(OutData%u_IceF) + ALLOCATE(OutData%u_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_IceF,1), UBOUND(OutData%u_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11426,13 +11524,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceF(i1), ErrStat2, ErrMsg2 ) ! u_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_MAP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_MAP)) DEALLOCATE(OutData%x_MAP) + ALLOCATE(OutData%x_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_MAP,1), UBOUND(OutData%x_MAP,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11466,13 +11580,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MAP(i1), ErrStat2, ErrMsg2 ) ! x_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_MAP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_MAP)) DEALLOCATE(OutData%xd_MAP) + ALLOCATE(OutData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_MAP,1), UBOUND(OutData%xd_MAP,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11506,27 +11636,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MAP(i1), ErrStat2, ErrMsg2 ) ! xd_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_MAP not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_MAP)) DEALLOCATE(OutData%z_MAP) + ALLOCATE(OutData%z_MAP(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%z_MAP,1), UBOUND(OutData%z_MAP,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11560,7 +11692,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MAP(i1), ErrStat2, ErrMsg2 ) ! z_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11569,703 +11701,356 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_MAP not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%u_MAP)) DEALLOCATE(OutData%u_MAP) + ALLOCATE(OutData%u_MAP(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackAeroDyn14_Data - - SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) - CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN - ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn_Data - - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) - CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(AeroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn_Data - - SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i1 = LBOUND(OutData%u_MAP,1), UBOUND(OutData%u_MAP,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MAP(i1), ErrStat2, ErrMsg2 ) ! u_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) 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 + 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(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_FEAM)) DEALLOCATE(OutData%x_FEAM) + ALLOCATE(OutData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_FEAM,1), UBOUND(OutData%x_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_FEAM(i1), ErrStat2, ErrMsg2 ) ! x_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_FEAM)) DEALLOCATE(OutData%xd_FEAM) + ALLOCATE(OutData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_FEAM,1), UBOUND(OutData%xd_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) ! xd_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_FEAM)) DEALLOCATE(OutData%z_FEAM) + ALLOCATE(OutData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_FEAM,1), UBOUND(OutData%z_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_FEAM(i1), ErrStat2, ErrMsg2 ) ! z_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_FEAM)) DEALLOCATE(OutData%OtherSt_FEAM) + ALLOCATE(OutData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_FEAM,1), UBOUND(OutData%OtherSt_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) ! OtherSt_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_FEAM)) DEALLOCATE(OutData%u_FEAM) + ALLOCATE(OutData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_FEAM,1), UBOUND(OutData%u_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_FEAM(i1), ErrStat2, ErrMsg2 ) ! u_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IF(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 ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_MD not allocated 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) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackAeroDyn_Data - - SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%x_MD)) DEALLOCATE(OutData%x_MD) + ALLOCATE(OutData%x_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_MD,1), UBOUND(OutData%x_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12299,7 +12084,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MD(i1), ErrStat2, ErrMsg2 ) ! x_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12307,9 +12092,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_MD)) DEALLOCATE(OutData%xd_MD) + ALLOCATE(OutData%xd_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_MD,1), UBOUND(OutData%xd_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12343,7 +12140,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MD(i1), ErrStat2, ErrMsg2 ) ! xd_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12351,9 +12148,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_MD)) DEALLOCATE(OutData%z_MD) + ALLOCATE(OutData%z_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_MD,1), UBOUND(OutData%z_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12387,7 +12196,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MD(i1), ErrStat2, ErrMsg2 ) ! z_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12395,9 +12204,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_MD)) DEALLOCATE(OutData%OtherSt_MD) + ALLOCATE(OutData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_MD,1), UBOUND(OutData%OtherSt_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12431,7 +12252,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12439,6 +12260,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_MD)) DEALLOCATE(OutData%u_MD) + ALLOCATE(OutData%u_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_MD,1), UBOUND(OutData%u_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12472,332 +12308,488 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MD(i1), ErrStat2, ErrMsg2 ) ! u_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END DO + END IF + END SUBROUTINE FAST_UnPackLinStateSave - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackAeroDyn_Data - - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData + SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData + TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_u,1) + i1_u = UBOUND(SrcLinTypeData%Names_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN + ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstLinTypeData%Names_u = SrcLinTypeData%Names_u ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_y,1) + i1_u = UBOUND(SrcLinTypeData%Names_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN + ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes + DstLinTypeData%Names_y = SrcLinTypeData%Names_y ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data +IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_x,1) + i1_u = UBOUND(SrcLinTypeData%Names_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN + ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Names_x = SrcLinTypeData%Names_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_xd,1) + i1_u = UBOUND(SrcLinTypeData%Names_xd,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN + ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_z,1) + i1_u = UBOUND(SrcLinTypeData%Names_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN + ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Names_z = SrcLinTypeData%Names_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_u)) THEN + i1_l = LBOUND(SrcLinTypeData%op_u,1) + i1_u = UBOUND(SrcLinTypeData%op_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN + ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_u = SrcLinTypeData%op_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_y)) THEN + i1_l = LBOUND(SrcLinTypeData%op_y,1) + i1_u = UBOUND(SrcLinTypeData%op_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN + ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_y = SrcLinTypeData%op_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x,1) + i1_u = UBOUND(SrcLinTypeData%op_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN + ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_x = SrcLinTypeData%op_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN + i1_l = LBOUND(SrcLinTypeData%op_dx,1) + i1_u = UBOUND(SrcLinTypeData%op_dx,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN + ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_dx = SrcLinTypeData%op_dx +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN + i1_l = LBOUND(SrcLinTypeData%op_xd,1) + i1_u = UBOUND(SrcLinTypeData%op_xd,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN + ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_xd = SrcLinTypeData%op_xd +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_z)) THEN + i1_l = LBOUND(SrcLinTypeData%op_z,1) + i1_u = UBOUND(SrcLinTypeData%op_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN + ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_z = SrcLinTypeData%op_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) + i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN + ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) + i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN + ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase +ENDIF +IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN + i1_l = LBOUND(SrcLinTypeData%Use_u,1) + i1_u = UBOUND(SrcLinTypeData%Use_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN + ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Use_u = SrcLinTypeData%Use_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN + i1_l = LBOUND(SrcLinTypeData%Use_y,1) + i1_u = UBOUND(SrcLinTypeData%Use_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN + ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Use_y = SrcLinTypeData%Use_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%A)) THEN + i1_l = LBOUND(SrcLinTypeData%A,1) + i1_u = UBOUND(SrcLinTypeData%A,1) + i2_l = LBOUND(SrcLinTypeData%A,2) + i2_u = UBOUND(SrcLinTypeData%A,2) + IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN + ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%A = SrcLinTypeData%A +ENDIF +IF (ALLOCATED(SrcLinTypeData%B)) THEN + i1_l = LBOUND(SrcLinTypeData%B,1) + i1_u = UBOUND(SrcLinTypeData%B,1) + i2_l = LBOUND(SrcLinTypeData%B,2) + i2_u = UBOUND(SrcLinTypeData%B,2) + IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN + ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%B = SrcLinTypeData%B +ENDIF +IF (ALLOCATED(SrcLinTypeData%C)) THEN + i1_l = LBOUND(SrcLinTypeData%C,1) + i1_u = UBOUND(SrcLinTypeData%C,1) + i2_l = LBOUND(SrcLinTypeData%C,2) + i2_u = UBOUND(SrcLinTypeData%C,2) + IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN + ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%C = SrcLinTypeData%C +ENDIF +IF (ALLOCATED(SrcLinTypeData%D)) THEN + i1_l = LBOUND(SrcLinTypeData%D,1) + i1_u = UBOUND(SrcLinTypeData%D,1) + i2_l = LBOUND(SrcLinTypeData%D,2) + i2_u = UBOUND(SrcLinTypeData%D,2) + IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN + ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%D = SrcLinTypeData%D +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRotation,1) + i1_u = UBOUND(SrcLinTypeData%StateRotation,1) + i2_l = LBOUND(SrcLinTypeData%StateRotation,2) + i2_u = UBOUND(SrcLinTypeData%StateRotation,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN + ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) + i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) + i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) + i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN + ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) + i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) + i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) + i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN + ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot +ENDIF +IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN + i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) + i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN + ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN + ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN + ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN + ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN + ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) + i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN + ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x +ENDIF + DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin + DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx + DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs + END SUBROUTINE FAST_CopyLinType - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData + SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) +IF (ALLOCATED(LinTypeData%Names_u)) THEN + DEALLOCATE(LinTypeData%Names_u) ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) +IF (ALLOCATED(LinTypeData%Names_y)) THEN + DEALLOCATE(LinTypeData%Names_y) ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data +IF (ALLOCATED(LinTypeData%Names_x)) THEN + DEALLOCATE(LinTypeData%Names_x) +ENDIF +IF (ALLOCATED(LinTypeData%Names_xd)) THEN + DEALLOCATE(LinTypeData%Names_xd) +ENDIF +IF (ALLOCATED(LinTypeData%Names_z)) THEN + DEALLOCATE(LinTypeData%Names_z) +ENDIF +IF (ALLOCATED(LinTypeData%op_u)) THEN + DEALLOCATE(LinTypeData%op_u) +ENDIF +IF (ALLOCATED(LinTypeData%op_y)) THEN + DEALLOCATE(LinTypeData%op_y) +ENDIF +IF (ALLOCATED(LinTypeData%op_x)) THEN + DEALLOCATE(LinTypeData%op_x) +ENDIF +IF (ALLOCATED(LinTypeData%op_dx)) THEN + DEALLOCATE(LinTypeData%op_dx) +ENDIF +IF (ALLOCATED(LinTypeData%op_xd)) THEN + DEALLOCATE(LinTypeData%op_xd) +ENDIF +IF (ALLOCATED(LinTypeData%op_z)) THEN + DEALLOCATE(LinTypeData%op_z) +ENDIF +IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN + DEALLOCATE(LinTypeData%op_x_eig_mag) +ENDIF +IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN + DEALLOCATE(LinTypeData%op_x_eig_phase) +ENDIF +IF (ALLOCATED(LinTypeData%Use_u)) THEN + DEALLOCATE(LinTypeData%Use_u) +ENDIF +IF (ALLOCATED(LinTypeData%Use_y)) THEN + DEALLOCATE(LinTypeData%Use_y) +ENDIF +IF (ALLOCATED(LinTypeData%A)) THEN + DEALLOCATE(LinTypeData%A) +ENDIF +IF (ALLOCATED(LinTypeData%B)) THEN + DEALLOCATE(LinTypeData%B) +ENDIF +IF (ALLOCATED(LinTypeData%C)) THEN + DEALLOCATE(LinTypeData%C) +ENDIF +IF (ALLOCATED(LinTypeData%D)) THEN + DEALLOCATE(LinTypeData%D) +ENDIF +IF (ALLOCATED(LinTypeData%StateRotation)) THEN + DEALLOCATE(LinTypeData%StateRotation) +ENDIF +IF (ALLOCATED(LinTypeData%StateRel_x)) THEN + DEALLOCATE(LinTypeData%StateRel_x) +ENDIF +IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN + DEALLOCATE(LinTypeData%StateRel_xdot) +ENDIF +IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN + DEALLOCATE(LinTypeData%IsLoad_u) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN + DEALLOCATE(LinTypeData%RotFrame_u) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN + DEALLOCATE(LinTypeData%RotFrame_y) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN + DEALLOCATE(LinTypeData%RotFrame_x) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN + DEALLOCATE(LinTypeData%RotFrame_z) +ENDIF +IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN + DEALLOCATE(LinTypeData%DerivOrder_x) +ENDIF + END SUBROUTINE FAST_DestroyLinType - SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(IN) :: InData + TYPE(FAST_LinType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -12812,7 +12804,7 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -12828,179 +12820,149 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + Int_BufSz = Int_BufSz + 1 ! Names_u allocated yes/no + IF ( ALLOCATED(InData%Names_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u END IF - Int_BufSz = Int_BufSz + 1 ! 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 + Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no + IF ( ALLOCATED(InData%Names_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y + END IF + Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no + IF ( ALLOCATED(InData%Names_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x + END IF + Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no + IF ( ALLOCATED(InData%Names_xd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd + END IF + Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no + IF ( ALLOCATED(InData%Names_z) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z + END IF + Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no + IF ( ALLOCATED(InData%op_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u + END IF + Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no + IF ( ALLOCATED(InData%op_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y + END IF + Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no + IF ( ALLOCATED(InData%op_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x + END IF + Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no + IF ( ALLOCATED(InData%op_dx) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx + END IF + Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no + IF ( ALLOCATED(InData%op_xd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd + END IF + Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no + IF ( ALLOCATED(InData%op_z) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z + END IF + Int_BufSz = Int_BufSz + 1 ! op_x_eig_mag allocated yes/no + IF ( ALLOCATED(InData%op_x_eig_mag) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_mag upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_mag) ! op_x_eig_mag + END IF + Int_BufSz = Int_BufSz + 1 ! op_x_eig_phase allocated yes/no + IF ( ALLOCATED(InData%op_x_eig_phase) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_phase upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_phase) ! op_x_eig_phase + END IF + Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no + IF ( ALLOCATED(InData%Use_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u + END IF + Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no + IF ( ALLOCATED(InData%Use_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y + END IF + Int_BufSz = Int_BufSz + 1 ! A allocated yes/no + IF ( ALLOCATED(InData%A) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%A) ! A + END IF + Int_BufSz = Int_BufSz + 1 ! B allocated yes/no + IF ( ALLOCATED(InData%B) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%B) ! B + END IF + Int_BufSz = Int_BufSz + 1 ! C allocated yes/no + IF ( ALLOCATED(InData%C) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%C) ! C + END IF + Int_BufSz = Int_BufSz + 1 ! D allocated yes/no + IF ( ALLOCATED(InData%D) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! D upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%D) ! D + END IF + Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no + IF ( ALLOCATED(InData%StateRotation) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation + END IF + Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no + IF ( ALLOCATED(InData%StateRel_x) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x + END IF + Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no + IF ( ALLOCATED(InData%StateRel_xdot) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no + IF ( ALLOCATED(InData%RotFrame_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no + IF ( ALLOCATED(InData%RotFrame_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no + IF ( ALLOCATED(InData%RotFrame_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_z allocated yes/no + IF ( ALLOCATED(InData%RotFrame_z) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z END IF + Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no + IF ( ALLOCATED(InData%DerivOrder_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x + END IF + Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin + Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx + Int_BufSz = Int_BufSz + 1 ! NumOutputs IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -13028,299 +12990,488 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%Names_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) + DO I = 1, LEN(InData%Names_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) + DO I = 1, LEN(InData%Names_y) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) + DO I = 1, LEN(InData%Names_x) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) + DO I = 1, LEN(InData%Names_xd) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) + DO I = 1, LEN(InData%Names_z) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_u,1), UBOUND(InData%op_u,1) + ReKiBuf(Re_Xferred) = InData%op_u(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_y,1), UBOUND(InData%op_y,1) + ReKiBuf(Re_Xferred) = InData%op_y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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 + DO i1 = LBOUND(InData%op_x,1), UBOUND(InData%op_x,1) + ReKiBuf(Re_Xferred) = InData%op_x(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_dx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_dx,1), UBOUND(InData%op_dx,1) + ReKiBuf(Re_Xferred) = InData%op_dx(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_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%op_xd,1), UBOUND(InData%op_xd,1) + ReKiBuf(Re_Xferred) = InData%op_xd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%op_z) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%op_z,1), UBOUND(InData%op_z,1) + ReKiBuf(Re_Xferred) = InData%op_z(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackInflowWind_Data + IF ( .NOT. ALLOCATED(InData%op_x_eig_mag) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_mag,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_mag,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + DO i1 = LBOUND(InData%op_x_eig_mag,1), UBOUND(InData%op_x_eig_mag,1) + DbKiBuf(Db_Xferred) = InData%op_x_eig_mag(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_x_eig_phase) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_phase,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_phase,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%op_x_eig_phase,1), UBOUND(InData%op_x_eig_phase,1) + DbKiBuf(Db_Xferred) = InData%op_x_eig_phase(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Use_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Use_u,1), UBOUND(InData%Use_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Use_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Use_y,1), UBOUND(InData%Use_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%A) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + DbKiBuf(Db_Xferred) = InData%A(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + DbKiBuf(Db_Xferred) = InData%B(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + DbKiBuf(Db_Xferred) = InData%C(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%D) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) + DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) + DbKiBuf(Db_Xferred) = InData%D(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%StateRotation,2), UBOUND(InData%StateRotation,2) + DO i1 = LBOUND(InData%StateRotation,1), UBOUND(InData%StateRotation,1) + DbKiBuf(Db_Xferred) = InData%StateRotation(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%StateRel_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%StateRel_x,2), UBOUND(InData%StateRel_x,2) + DO i1 = LBOUND(InData%StateRel_x,1), UBOUND(InData%StateRel_x,1) + DbKiBuf(Db_Xferred) = InData%StateRel_x(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%StateRel_xdot,2), UBOUND(InData%StateRel_xdot,2) + DO i1 = LBOUND(InData%StateRel_xdot,1), UBOUND(InData%StateRel_xdot,1) + DbKiBuf(Db_Xferred) = InData%StateRel_xdot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO i1 = LBOUND(InData%SizeLin,1), UBOUND(InData%SizeLin,1) + IntKiBuf(Int_Xferred) = InData%SizeLin(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinStartIndx,1), UBOUND(InData%LinStartIndx,1) + IntKiBuf(Int_Xferred) = InData%LinStartIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOutputs + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FAST_PackLinType + + SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(INOUT) :: OutData + TYPE(FAST_LinType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -13329,16 +13480,11 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -13349,570 +13495,680 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_u not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Names_u)) DEALLOCATE(OutData%Names_u) + ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) + DO I = 1, LEN(OutData%Names_u) + OutData%Names_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_y not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Names_y)) DEALLOCATE(OutData%Names_y) + ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) + DO I = 1, LEN(OutData%Names_y) + OutData%Names_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_x)) DEALLOCATE(OutData%Names_x) + ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) + DO I = 1, LEN(OutData%Names_x) + OutData%Names_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END IF - END SUBROUTINE FAST_UnPackInflowWind_Data - - SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData - TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOpenFOAM_Data - - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - 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 ) - END SUBROUTINE FAST_DestroyOpenFOAM_Data - - SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpenFOAM_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOpenFOAM_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_xd)) DEALLOCATE(OutData%Names_xd) + ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) + DO I = 1, LEN(OutData%Names_xd) + OutData%Names_xd(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_z)) DEALLOCATE(OutData%Names_z) + ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) + DO I = 1, LEN(OutData%Names_z) + OutData%Names_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_u)) DEALLOCATE(OutData%op_u) + ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_u,1), UBOUND(OutData%op_u,1) + OutData%op_u(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_y)) DEALLOCATE(OutData%op_y) + ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_y,1), UBOUND(OutData%op_y,1) + OutData%op_y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_x)) DEALLOCATE(OutData%op_x) + ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_x,1), UBOUND(OutData%op_x,1) + OutData%op_x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_dx)) DEALLOCATE(OutData%op_dx) + ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_dx,1), UBOUND(OutData%op_dx,1) + OutData%op_dx(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_xd)) DEALLOCATE(OutData%op_xd) + ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_xd,1), UBOUND(OutData%op_xd,1) + OutData%op_xd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_z)) DEALLOCATE(OutData%op_z) + ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_z,1), UBOUND(OutData%op_z,1) + OutData%op_z(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_mag not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_x_eig_mag)) DEALLOCATE(OutData%op_x_eig_mag) + ALLOCATE(OutData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_x_eig_mag,1), UBOUND(OutData%op_x_eig_mag,1) + OutData%op_x_eig_mag(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_phase not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_x_eig_phase)) DEALLOCATE(OutData%op_x_eig_phase) + ALLOCATE(OutData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_x_eig_phase,1), UBOUND(OutData%op_x_eig_phase,1) + OutData%op_x_eig_phase(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Use_u)) DEALLOCATE(OutData%Use_u) + ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Use_u,1), UBOUND(OutData%Use_u,1) + OutData%Use_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Use_y)) DEALLOCATE(OutData%Use_y) + ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Use_y,1), UBOUND(OutData%Use_y,1) + OutData%Use_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) + ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) + ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) + ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%D)) DEALLOCATE(OutData%D) + ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) + DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) + OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StateRotation)) DEALLOCATE(OutData%StateRotation) + ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StateRotation,2), UBOUND(OutData%StateRotation,2) + DO i1 = LBOUND(OutData%StateRotation,1), UBOUND(OutData%StateRotation,1) + OutData%StateRotation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StateRel_x)) DEALLOCATE(OutData%StateRel_x) + ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StateRel_x,2), UBOUND(OutData%StateRel_x,2) + DO i1 = LBOUND(OutData%StateRel_x,1), UBOUND(OutData%StateRel_x,1) + OutData%StateRel_x(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) + ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StateRel_xdot,2), UBOUND(OutData%StateRel_xdot,2) + DO i1 = LBOUND(OutData%StateRel_xdot,1), UBOUND(OutData%StateRel_xdot,1) + OutData%StateRel_xdot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) + ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) + ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) + ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_z)) DEALLOCATE(OutData%RotFrame_z) + ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) + OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) + ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + i1_l = LBOUND(OutData%SizeLin,1) + i1_u = UBOUND(OutData%SizeLin,1) + DO i1 = LBOUND(OutData%SizeLin,1), UBOUND(OutData%SizeLin,1) + OutData%SizeLin(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%LinStartIndx,1) + i1_u = UBOUND(OutData%LinStartIndx,1) + DO i1 = LBOUND(OutData%LinStartIndx,1), UBOUND(OutData%LinStartIndx,1) + OutData%LinStartIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FAST_UnPackLinType + + SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData + TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN + i1_l = LBOUND(SrcModLinTypeData%Instance,1) + i1_u = UBOUND(SrcModLinTypeData%Instance,1) + IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN + ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) + CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE FAST_CopyModLinType + + SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ModLinTypeData%Instance)) THEN +DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) + CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModLinTypeData%Instance) +ENDIF + END SUBROUTINE FAST_DestroyModLinType + + SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ModLinType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModLinType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Instance allocated yes/no + IF ( ALLOCATED(InData%Instance) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) + Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Instance + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Instance + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Instance + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -13940,7 +14196,18 @@ SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + IF ( .NOT. ALLOCATED(InData%Instance) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Instance,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13968,97 +14235,15 @@ SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END DO + END IF + END SUBROUTINE FAST_PackModLinType - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackOpenFOAM_Data - - SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OutData + TYPE(FAST_ModLinType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -14067,15 +14252,10 @@ SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModLinType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14086,6 +14266,20 @@ SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Instance not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Instance)) DEALLOCATE(OutData%Instance) + ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14119,179 +14313,65 @@ SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackOpenFOAM_Data + END DO + END IF + END SUBROUTINE FAST_UnPackModLinType - SUBROUTINE FAST_CopySuperController_Data( SrcSuperController_DataData, DstSuperController_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SuperController_Data), INTENT(IN) :: SrcSuperController_DataData - TYPE(SuperController_Data), INTENT(INOUT) :: DstSuperController_DataData + SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData + TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySuperController_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' ! ErrStat = ErrID_None ErrMsg = "" - CALL SC_CopyInput( SrcSuperController_DataData%u, DstSuperController_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyOutput( SrcSuperController_DataData%y, DstSuperController_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) + CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyParam( SrcSuperController_DataData%p, DstSuperController_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO + CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopySuperController_Data + DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed + DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed + END SUBROUTINE FAST_CopyLinFileType - SUBROUTINE FAST_DestroySuperController_Data( SuperController_DataData, ErrStat, ErrMsg ) - TYPE(SuperController_Data), INTENT(INOUT) :: SuperController_DataData + SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySuperController_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - CALL SC_DestroyInput( SuperController_DataData%u, ErrStat, ErrMsg ) - CALL SC_DestroyOutput( SuperController_DataData%y, ErrStat, ErrMsg ) - CALL SC_DestroyParam( SuperController_DataData%p, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroySuperController_Data +DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) + CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat, ErrMsg ) +ENDDO + CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyLinFileType - SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SuperController_Data), INTENT(IN) :: InData + TYPE(FAST_LinFileType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -14306,7 +14386,7 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSuperController_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinFileType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14323,57 +14403,45 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_BufSz = 0 Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) + Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype + CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y + IF(ALLOCATED(Re_Buf)) THEN ! Modules Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! y + IF(ALLOCATED(Db_Buf)) THEN ! Modules Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! y + IF(ALLOCATED(Int_Buf)) THEN ! Modules Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + END DO + Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p + IF(ALLOCATED(Re_Buf)) THEN ! Glue Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! p + IF(ALLOCATED(Db_Buf)) THEN ! Glue Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! p + IF(ALLOCATED(Int_Buf)) THEN ! Glue Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Re_BufSz = Re_BufSz + 1 ! Azimuth + Re_BufSz = Re_BufSz + 1 ! WindSpeed IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -14401,35 +14469,8 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) + CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14457,7 +14498,8 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14485,13 +14527,19 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE FAST_PackSuperController_Data + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Azimuth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WindSpeed + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE FAST_PackLinFileType - SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SuperController_Data), INTENT(INOUT) :: OutData + TYPE(FAST_LinFileType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -14500,15 +14548,10 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSuperController_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinFileType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14519,6 +14562,9 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + i1_l = LBOUND(OutData%Modules,1) + i1_u = UBOUND(OutData%Modules,1) + DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14552,53 +14598,14 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL FAST_Unpackmodlintype( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14632,133 +14639,153 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackSuperController_Data + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Azimuth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE FAST_UnPackLinFileType - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData + SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData + TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMiscLinType' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) + i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN + ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode +IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) + i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN + ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget +ENDIF + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx +IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) + i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN + ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN + ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp ENDIF - END SUBROUTINE FAST_CopySubDyn_Data +IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN + ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) + i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN + ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot +ENDIF + END SUBROUTINE FAST_CopyMiscLinType - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData + SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(SubDyn_DataData%Input) +IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN + DEALLOCATE(MiscLinTypeData%LinTimes) ENDIF -IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes) +IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN + DEALLOCATE(MiscLinTypeData%AzimTarget) ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data +IF (ALLOCATED(MiscLinTypeData%Psi)) THEN + DEALLOCATE(MiscLinTypeData%Psi) +ENDIF +IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN + DEALLOCATE(MiscLinTypeData%y_interp) +ENDIF +IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN + DEALLOCATE(MiscLinTypeData%y_ref) +ENDIF +IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN + DEALLOCATE(MiscLinTypeData%Y_prevRot) +ENDIF + END SUBROUTINE FAST_DestroyMiscLinType - SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(IN) :: InData + TYPE(FAST_MiscLinType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -14773,7 +14800,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMiscLinType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14789,178 +14816,41 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no + IF ( ALLOCATED(InData%LinTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes END IF - Int_BufSz = Int_BufSz + 1 ! 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 + Int_BufSz = Int_BufSz + 1 ! CopyOP_CtrlCode + Int_BufSz = Int_BufSz + 1 ! AzimTarget allocated yes/no + IF ( ALLOCATED(InData%AzimTarget) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AzimTarget upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%AzimTarget) ! AzimTarget + END IF + Int_BufSz = Int_BufSz + 1 ! IsConverged + Int_BufSz = Int_BufSz + 1 ! FoundSteady + Int_BufSz = Int_BufSz + 1 ! n_rot + Int_BufSz = Int_BufSz + 1 ! AzimIndx + Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx + Int_BufSz = Int_BufSz + 1 ! Psi allocated yes/no + IF ( ALLOCATED(InData%Psi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Psi upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Psi) ! Psi + END IF + Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no + IF ( ALLOCATED(InData%y_interp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%y_interp) ! y_interp + END IF + Int_BufSz = Int_BufSz + 1 ! y_ref allocated yes/no + IF ( ALLOCATED(InData%y_ref) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_ref upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%y_ref) ! y_ref + END IF + Int_BufSz = Int_BufSz + 1 ! Y_prevRot allocated yes/no + IF ( ALLOCATED(InData%Y_prevRot) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Y_prevRot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Y_prevRot) ! Y_prevRot END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -14989,299 +14879,120 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%LinTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) + DbKiBuf(Db_Xferred) = InData%LinTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%CopyOP_CtrlCode + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%AzimTarget) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimTarget,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimTarget,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%AzimTarget,1), UBOUND(InData%AzimTarget,1) + DbKiBuf(Db_Xferred) = InData%AzimTarget(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsConverged, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FoundSteady, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_rot + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AzimIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Psi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Psi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psi,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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 + DO i1 = LBOUND(InData%Psi,1), UBOUND(InData%Psi,1) + DbKiBuf(Db_Xferred) = InData%Psi(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + ReKiBuf(Re_Xferred) = InData%y_interp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_ref) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_ref,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_ref,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_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%y_ref,1), UBOUND(InData%y_ref,1) + ReKiBuf(Re_Xferred) = InData%y_ref(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%Y_prevRot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%Y_prevRot,2), UBOUND(InData%Y_prevRot,2) + DO i1 = LBOUND(InData%Y_prevRot,1), UBOUND(InData%Y_prevRot,1) + ReKiBuf(Re_Xferred) = InData%Y_prevRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_PackSubDyn_Data + END SUBROUTINE FAST_PackMiscLinType - SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(INOUT) :: OutData + TYPE(FAST_MiscLinType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -15290,16 +15001,11 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMiscLinType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -15310,541 +15016,258 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LinTimes)) DEALLOCATE(OutData%LinTimes) + ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) + OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + OutData%CopyOP_CtrlCode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimTarget not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%AzimTarget)) DEALLOCATE(OutData%AzimTarget) + ALLOCATE(OutData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%AzimTarget,1), UBOUND(OutData%AzimTarget,1) + OutData%AzimTarget(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%IsConverged = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsConverged) + Int_Xferred = Int_Xferred + 1 + OutData%FoundSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%FoundSteady) + Int_Xferred = Int_Xferred + 1 + OutData%n_rot = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AzimIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Psi)) DEALLOCATE(OutData%Psi) + ALLOCATE(OutData%Psi(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Psi,1), UBOUND(OutData%Psi,1) + OutData%Psi(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackSubDyn_Data + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) + ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) + OutData%y_interp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_ref not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_ref)) DEALLOCATE(OutData%y_ref) + ALLOCATE(OutData%y_ref(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_ref,1), UBOUND(OutData%y_ref,1) + OutData%y_ref(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_prevRot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Y_prevRot)) DEALLOCATE(OutData%Y_prevRot) + ALLOCATE(OutData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Y_prevRot,2), UBOUND(OutData%Y_prevRot,2) + DO i1 = LBOUND(OutData%Y_prevRot,1), UBOUND(OutData%Y_prevRot,1) + OutData%Y_prevRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FAST_UnPackMiscLinType - SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData - TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData + SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData + TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) - CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) - CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) - CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN - ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) + i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN + ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) + i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) + i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) + i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN + ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyExtPtfm_Data - - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) - CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) - CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(ExtPtfm_DataData%Input) -ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes) + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData ENDIF - END SUBROUTINE FAST_DestroyExtPtfm_Data - - SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines +IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames +ENDIF +IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits +ENDIF + DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + DstOutputFileTypeData%OutFmt_a = SrcOutputFileTypeData%OutFmt_a + CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyOutputFileType + + SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN + DEALLOCATE(OutputFileTypeData%TimeData) +ENDIF +IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN + DEALLOCATE(OutputFileTypeData%AllOutData) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN + DEALLOCATE(OutputFileTypeData%ChannelNames) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN + DEALLOCATE(OutputFileTypeData%ChannelUnits) +ENDIF +DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) +ENDDO + CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat, ErrMsg ) + CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyOutputFileType + + SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_Data), INTENT(IN) :: InData + TYPE(FAST_OutputFileType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -15859,7 +15282,7 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExtPtfm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -15875,179 +15298,93 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no + IF ( ALLOCATED(InData%TimeData) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData + END IF + Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no + IF ( ALLOCATED(InData%AllOutData) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData + END IF + Int_BufSz = Int_BufSz + 1 ! n_Out + Int_BufSz = Int_BufSz + 1 ! NOutSteps + Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts + Int_BufSz = Int_BufSz + 1 ! UnOu + Int_BufSz = Int_BufSz + 1 ! UnSum + Int_BufSz = Int_BufSz + 1 ! UnGra + Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines + Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no + IF ( ALLOCATED(InData%ChannelNames) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames + END IF + Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no + IF ( ALLOCATED(InData%ChannelUnits) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits + END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) + Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev + Int_BufSz = Int_BufSz + 1 ! WriteThisStep + Int_BufSz = Int_BufSz + 1 ! VTK_count + Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx + Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype + CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! m + IF(ALLOCATED(Re_Buf)) THEN ! Lin Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! m + IF(ALLOCATED(Db_Buf)) THEN ! Lin Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! m + IF(ALLOCATED(Int_Buf)) THEN ! Lin Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + Int_BufSz = Int_BufSz + 1 ! ActualChanLen + Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_a) ! OutFmt_a + Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype + CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input + IF(ALLOCATED(Re_Buf)) THEN ! op Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input + IF(ALLOCATED(Db_Buf)) THEN ! op Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input + IF(ALLOCATED(Int_Buf)) THEN ! op Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -16075,155 +15412,97 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) + DbKiBuf(Db_Xferred) = InData%TimeData(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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 i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) + DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) + ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%n_Out + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutSteps + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%numOuts,1), UBOUND(InData%numOuts,1) + IntKiBuf(Int_Xferred) = InData%numOuts(i1) + Int_Xferred = Int_Xferred + 1 END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IntKiBuf(Int_Xferred) = InData%UnOu + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnGra + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) + DO I = 1, LEN(InData%FileDescLines) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelNames,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) + DO I = 1, LEN(InData%ChannelNames) + IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelUnits,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) + DO I = 1, LEN(InData%ChannelUnits) + IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16251,7 +15530,20 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + END DO + DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) + DO I = 1, LEN(InData%Module_Abrev) + IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteThisStep, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_count + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx + Int_Xferred = Int_Xferred + 1 + CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16279,7 +15571,13 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + IntKiBuf(Int_Xferred) = InData%ActualChanLen + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt_a) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_a(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16307,186 +15605,144 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 + END SUBROUTINE FAST_PackOutputFileType + + SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOutputFileType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + IF (ALLOCATED(OutData%TimeData)) DEALLOCATE(OutData%TimeData) + ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) + OutData%TimeData(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated 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) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AllOutData)) DEALLOCATE(OutData%AllOutData) + ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) + DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) + OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_PackExtPtfm_Data - - SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExtPtfm_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) + OutData%n_Out = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%numOuts,1) + i1_u = UBOUND(OutData%numOuts,1) + DO i1 = LBOUND(OutData%numOuts,1), UBOUND(OutData%numOuts,1) + OutData%numOuts(i1) = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%UnOu = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnGra = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%FileDescLines,1) + i1_u = UBOUND(OutData%FileDescLines,1) + DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) + DO I = 1, LEN(OutData%FileDescLines) + OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ChannelNames)) DEALLOCATE(OutData%ChannelNames) + ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) + DO I = 1, LEN(OutData%ChannelNames) + OutData%ChannelNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelUnits not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) + ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) + DO I = 1, LEN(OutData%ChannelUnits) + OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + i1_l = LBOUND(OutData%Module_Ver,1) + i1_u = UBOUND(OutData%Module_Ver,1) + DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16520,7 +15776,7 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16528,50 +15784,20 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%Module_Abrev,1) + i1_u = UBOUND(OutData%Module_Abrev,1) + DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) + DO I = 1, LEN(OutData%Module_Abrev) + OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO + OutData%WriteThisStep = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteThisStep) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_count = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_LastWaveIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16605,147 +15831,19 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL FAST_Unpacklinfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE + OutData%ActualChanLen = 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%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) + DO I = 1, LEN(OutData%OutFmt_a) + OutData%OutFmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16779,158 +15877,294 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL FAST_Unpacklinstatesave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackExtPtfm_Data + END SUBROUTINE FAST_UnPackOutputFileType - SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData - TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData + SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData + TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) - CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) - CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) - CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%x,1) + i1_u = UBOUND(SrcIceDyn_DataData%x,1) + i2_l = LBOUND(SrcIceDyn_DataData%x,2) + i2_u = UBOUND(SrcIceDyn_DataData%x,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN + ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) + DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) + CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) - CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN - ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%xd,1) + i1_u = UBOUND(SrcIceDyn_DataData%xd,1) + i2_l = LBOUND(SrcIceDyn_DataData%xd,2) + i2_u = UBOUND(SrcIceDyn_DataData%xd,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN + ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) + DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) + CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%z,1) + i1_u = UBOUND(SrcIceDyn_DataData%z,1) + i2_l = LBOUND(SrcIceDyn_DataData%z,2) + i2_u = UBOUND(SrcIceDyn_DataData%z,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN + ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes + DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) + DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) + CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF - END SUBROUTINE FAST_CopyHydroDyn_Data +IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) + i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) + i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) + i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN + ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) + DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) + CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%p,1) + i1_u = UBOUND(SrcIceDyn_DataData%p,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN + ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) + CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%u,1) + i1_u = UBOUND(SrcIceDyn_DataData%u,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN + ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%y,1) + i1_u = UBOUND(SrcIceDyn_DataData%y,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN + ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) + CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%m,1) + i1_u = UBOUND(SrcIceDyn_DataData%m,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN + ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) + CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%Input,1) + i1_u = UBOUND(SrcIceDyn_DataData%Input,1) + i2_l = LBOUND(SrcIceDyn_DataData%Input,2) + i2_u = UBOUND(SrcIceDyn_DataData%Input,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN + ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) + DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) + i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) + i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN + ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyIceDyn_Data - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData + SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) + TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat, ErrMsg ) +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 ) ENDDO -DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) - CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) - CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat, ErrMsg ) + DEALLOCATE(IceDyn_DataData%x) +ENDIF +IF (ALLOCATED(IceDyn_DataData%xd)) THEN +DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) +DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) + CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) - CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) 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 ) -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 ) + DEALLOCATE(IceDyn_DataData%xd) +ENDIF +IF (ALLOCATED(IceDyn_DataData%z)) THEN +DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) +DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) + CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(HydroDyn_DataData%Input) +ENDDO + DEALLOCATE(IceDyn_DataData%z) ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes) +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 ) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%OtherSt) ENDIF - END SUBROUTINE FAST_DestroyHydroDyn_Data +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 ) +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 ) +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 ) +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 ) +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 ) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%Input) +ENDIF +IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN + DEALLOCATE(IceDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyIceDyn_Data - SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_Data), INTENT(IN) :: InData + TYPE(IceDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -16945,7 +16179,7 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -16961,10 +16195,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x allocated yes/no + IF ( ALLOCATED(InData%x) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16981,9 +16219,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no + IF ( ALLOCATED(InData%xd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17000,9 +16244,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z allocated yes/no + IF ( ALLOCATED(InData%z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17019,9 +16269,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no + IF ( ALLOCATED(InData%OtherSt) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17038,8 +16294,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! p allocated yes/no + IF ( ALLOCATED(InData%p) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17055,8 +16317,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u allocated yes/no + IF ( ALLOCATED(InData%u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17072,8 +16340,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y allocated yes/no + IF ( ALLOCATED(InData%y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17089,8 +16363,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! m allocated yes/no + IF ( ALLOCATED(InData%m) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17106,12 +16386,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17128,10 +16411,11 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF IF ( Re_BufSz .GT. 0 ) THEN @@ -17161,8 +16445,22 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17191,8 +16489,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17221,8 +16535,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17251,8 +16581,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17281,7 +16627,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + END IF + IF ( .NOT. ALLOCATED(InData%p) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) + CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17309,7 +16668,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17337,7 +16709,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17365,7 +16750,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + END DO + END IF + IF ( .NOT. ALLOCATED(InData%m) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) + CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17393,6 +16791,8 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + END DO + END IF IF ( .NOT. ALLOCATED(InData%Input) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -17402,9 +16802,13 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + Int_Xferred = Int_Xferred + 2 + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17433,6 +16837,7 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -17442,18 +16847,25 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_PackHydroDyn_Data + END SUBROUTINE FAST_PackIceDyn_Data - SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_Data), INTENT(INOUT) :: OutData + TYPE(IceDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -17462,16 +16874,11 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -17482,8 +16889,23 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) + ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17518,7 +16940,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17526,8 +16948,25 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) + ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17562,7 +17001,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17570,8 +17009,25 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) + ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17606,7 +17062,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17614,8 +17070,25 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) + ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17650,7 +17123,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17658,6 +17131,22 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) + ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17691,13 +17180,29 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) + ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17731,13 +17236,29 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) + ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17771,13 +17292,29 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) + ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17811,13 +17348,15 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -17825,12 +17364,16 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF + DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17865,7 +17408,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17873,6 +17416,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated Int_Xferred = Int_Xferred + 1 @@ -17881,142 +17425,353 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_UnPackHydroDyn_Data + END SUBROUTINE FAST_UnPackIceDyn_Data - SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData - TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData + SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData + TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) - CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%x,1) + i1_u = UBOUND(SrcBeamDyn_DataData%x,1) + i2_l = LBOUND(SrcBeamDyn_DataData%x,2) + i2_u = UBOUND(SrcBeamDyn_DataData%x,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN + ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) + CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) - CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) + i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) + i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) + i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN + ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) + CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) - CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%z,1) + i1_u = UBOUND(SrcBeamDyn_DataData%z,1) + i2_l = LBOUND(SrcBeamDyn_DataData%z,2) + i2_u = UBOUND(SrcBeamDyn_DataData%z,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN + ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) + CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) - CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) + i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) + i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) + i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN + ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) + CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%p,1) + i1_u = UBOUND(SrcBeamDyn_DataData%p,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN + ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) + CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%u,1) + i1_u = UBOUND(SrcBeamDyn_DataData%u,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN + ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN + ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%m,1) + i1_u = UBOUND(SrcBeamDyn_DataData%m,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN + ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) + CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN - ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN + ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN + ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN + ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes + DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF - END SUBROUTINE FAST_CopyIceFloe_Data +IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) + i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) + i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN + ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyBeamDyn_Data - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData + SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat, ErrMsg ) +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 ) ENDDO -DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) - CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) - CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat, ErrMsg ) + DEALLOCATE(BeamDyn_DataData%x) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%xd)) THEN +DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) +DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) + CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) - CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat, ErrMsg ) 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 ) -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 ) + DEALLOCATE(BeamDyn_DataData%xd) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%z)) THEN +DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) +DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) + CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(IceFloe_DataData%Input) +ENDDO + DEALLOCATE(BeamDyn_DataData%z) ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes) +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 ) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%OtherSt) ENDIF - END SUBROUTINE FAST_DestroyIceFloe_Data +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +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 ) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Input) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN + DEALLOCATE(BeamDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyBeamDyn_Data - SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_Data), INTENT(IN) :: InData + TYPE(BeamDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -18031,7 +17786,7 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackBeamDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -18047,10 +17802,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x allocated yes/no + IF ( ALLOCATED(InData%x) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18067,9 +17826,15 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no + IF ( ALLOCATED(InData%xd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18086,9 +17851,15 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z allocated yes/no + IF ( ALLOCATED(InData%z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18105,9 +17876,15 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no + IF ( ALLOCATED(InData%OtherSt) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18124,8 +17901,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! p allocated yes/no + IF ( ALLOCATED(InData%p) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18141,8 +17924,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u allocated yes/no + IF ( ALLOCATED(InData%u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18158,8 +17947,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y allocated yes/no + IF ( ALLOCATED(InData%y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18175,8 +17970,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! m allocated yes/no + IF ( ALLOCATED(InData%m) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18192,38 +17993,90 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Output upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input + IF(ALLOCATED(Re_Buf)) THEN ! Output Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input + IF(ALLOCATED(Db_Buf)) THEN ! Output Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input + IF(ALLOCATED(Int_Buf)) THEN ! Output Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO + END DO END IF - Int_BufSz = Int_BufSz + 1 ! 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 + Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no + IF ( ALLOCATED(InData%y_interp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF @@ -18247,8 +18100,22 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18277,8 +18144,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18307,8 +18190,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18337,8 +18236,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18367,7 +18282,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + END IF + IF ( .NOT. ALLOCATED(InData%p) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) + CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18395,7 +18323,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18423,7 +18364,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18451,7 +18405,107 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + END DO + END IF + IF ( .NOT. ALLOCATED(InData%m) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) + CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18479,6 +18533,8 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + END DO + END IF IF ( .NOT. ALLOCATED(InData%Input) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18488,9 +18544,13 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + Int_Xferred = Int_Xferred + 2 + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18519,6 +18579,7 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18528,18 +18589,25 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_PackIceFloe_Data + END SUBROUTINE FAST_PackBeamDyn_Data - SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_Data), INTENT(INOUT) :: OutData + TYPE(BeamDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -18548,16 +18616,11 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackBeamDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -18568,8 +18631,23 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) + ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18604,7 +18682,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18612,8 +18690,25 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) + ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18648,7 +18743,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18656,8 +18751,25 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) + ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18692,7 +18804,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18700,8 +18812,25 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) + ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18736,7 +18865,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18744,6 +18873,22 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) + ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18777,13 +18922,29 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) + ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18817,13 +18978,29 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) + ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18857,13 +19034,29 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) + ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18897,27 +19090,33 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(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%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i2 = LBOUND(OutData%Output,2), UBOUND(OutData%Output,2) + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18951,7 +19150,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1,i2), ErrStat2, ErrMsg2 ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18959,146 +19158,294 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) + ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp(i1), ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackIceFloe_Data - - SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData - TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 + DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FAST_UnPackBeamDyn_Data + + SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData + TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) - CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) + CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) - CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) + CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) - CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) + CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) + CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO + CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Input)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input,1) - i1_u = UBOUND(SrcMAP_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN - ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN + ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) + CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN - ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN + ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes + DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) + CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyMAP_Data +IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN + ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyElastoDyn_Data - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData + SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) + CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) - CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) + CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) - CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) + CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat, ErrMsg ) 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 ) -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 ) +DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) + CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(MAP_DataData%Input) + 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 ) +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 ) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Output) ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes)) THEN - DEALLOCATE(MAP_DataData%InputTimes) + CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Input) ENDIF - END SUBROUTINE FAST_DestroyMAP_Data +IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN + DEALLOCATE(ElastoDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyElastoDyn_Data - SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_Data), INTENT(IN) :: InData + TYPE(ElastoDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -19113,7 +19460,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackElastoDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -19132,7 +19479,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19151,7 +19498,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19170,7 +19517,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19187,8 +19534,9 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19204,8 +19552,9 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19222,7 +19571,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19239,7 +19588,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19255,20 +19604,60 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old + IF(ALLOCATED(Re_Buf)) THEN ! m Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old + IF(ALLOCATED(Db_Buf)) THEN ! m Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -19277,7 +19666,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19328,7 +19717,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19358,7 +19747,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19388,7 +19777,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19417,7 +19806,8 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19445,7 +19835,8 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19473,7 +19864,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19501,7 +19892,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19529,7 +19920,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old + CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19557,18 +19948,87 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN + 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,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%Input,1), UBOUND(InData%Input,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19608,16 +20068,18 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackMAP_Data + END SUBROUTINE FAST_PackElastoDyn_Data - SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_Data), INTENT(INOUT) :: OutData + TYPE(ElastoDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -19626,16 +20088,10 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackElastoDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -19682,7 +20138,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19726,7 +20182,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19770,7 +20226,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19778,6 +20234,9 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -19811,13 +20270,14 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -19851,7 +20311,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19891,7 +20351,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19931,7 +20391,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19971,7 +20431,103 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old + CALL ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20025,7 +20581,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20047,21 +20603,16 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackMAP_Data + END SUBROUTINE FAST_UnPackElastoDyn_Data - SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData - TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData + SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData + TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -20070,113 +20621,139 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) - CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) + CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) - CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) + CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) - CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) + CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) - CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) + CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN - ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Output,1) + i1_u = UBOUND(SrcServoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN + ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Input,1) + i1_u = UBOUND(SrcServoDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN + ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes + DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) + CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyFEAMooring_Data +IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN + ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyServoDyn_Data - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData + SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) + TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) + CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) - CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) + CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) - CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) + CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) - CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) + CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) 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 ) -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 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 ) +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 ) ENDDO - DEALLOCATE(FEAMooring_DataData%Input) + DEALLOCATE(ServoDyn_DataData%Output) ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes) + CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(ServoDyn_DataData%Input) ENDIF - END SUBROUTINE FAST_DestroyFEAMooring_Data +IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN + DEALLOCATE(ServoDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyServoDyn_Data - SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAMooring_Data), INTENT(IN) :: InData + TYPE(ServoDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -20191,7 +20768,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackServoDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -20210,7 +20787,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20229,7 +20806,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20248,7 +20825,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20267,7 +20844,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20285,7 +20862,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20302,7 +20879,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20319,7 +20896,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20336,7 +20913,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20352,12 +20929,52 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20408,7 +21025,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20438,7 +21055,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20468,7 +21085,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20498,7 +21115,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20527,7 +21144,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20555,7 +21172,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20583,7 +21200,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20611,7 +21228,76 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20650,7 +21336,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20690,16 +21376,18 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackFEAMooring_Data + END SUBROUTINE FAST_PackServoDyn_Data - SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAMooring_Data), INTENT(INOUT) :: OutData + TYPE(ServoDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -20708,16 +21396,10 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackServoDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -20764,7 +21446,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20808,7 +21490,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20852,7 +21534,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20896,7 +21578,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20937,7 +21619,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20977,7 +21659,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21017,7 +21699,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21057,7 +21739,103 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21111,7 +21889,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21133,21 +21911,16 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackFEAMooring_Data + END SUBROUTINE FAST_UnPackServoDyn_Data - SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData - TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData + SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData + TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -21156,113 +21929,113 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) - CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) + CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) - CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) + CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) - CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) + CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) - CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) + CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN - ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN + ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN + ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes + DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyMoorDyn_Data + END SUBROUTINE FAST_CopyAeroDyn14_Data - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData + SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) + CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) - CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) + CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) - CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) + CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) - CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) + CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat, ErrMsg ) 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 ) -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 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 ) +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 ) ENDDO - DEALLOCATE(MoorDyn_DataData%Input) + DEALLOCATE(AeroDyn14_DataData%Input) ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes) +IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN + DEALLOCATE(AeroDyn14_DataData%InputTimes) ENDIF - END SUBROUTINE FAST_DestroyMoorDyn_Data + END SUBROUTINE FAST_DestroyAeroDyn14_Data - SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MoorDyn_Data), INTENT(IN) :: InData + TYPE(AeroDyn14_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -21277,7 +22050,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn14_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -21296,7 +22069,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21315,7 +22088,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21334,7 +22107,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21353,7 +22126,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21371,7 +22144,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21388,7 +22161,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21405,7 +22178,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21422,7 +22195,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21443,7 +22216,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21494,7 +22267,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21524,7 +22297,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21554,7 +22327,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21584,7 +22357,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21613,7 +22386,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21641,7 +22414,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21669,7 +22442,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21697,7 +22470,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21736,7 +22509,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E 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 AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21776,16 +22549,18 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackMoorDyn_Data + END SUBROUTINE FAST_PackAeroDyn14_Data - SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MoorDyn_Data), INTENT(INOUT) :: OutData + TYPE(AeroDyn14_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -21794,16 +22569,10 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn14_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -21850,7 +22619,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21894,7 +22663,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21938,7 +22707,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21982,7 +22751,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22023,7 +22792,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat 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 AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22063,7 +22832,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat 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 AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22103,7 +22872,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat 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 AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22143,7 +22912,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat 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 AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22197,7 +22966,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat 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 AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22219,21 +22988,16 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackMoorDyn_Data + END SUBROUTINE FAST_UnPackAeroDyn14_Data - SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData - TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData + SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData + TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -22242,113 +23006,139 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) - CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) + CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) - CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) + CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) - CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) + CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) - CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) + CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN + ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) + CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN + ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes + DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) + CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyOrcaFlex_Data +IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN + ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyAeroDyn_Data - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData + SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) + TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) + CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) - CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) + CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) - CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) + CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) - CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) + CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) 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 ) -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 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 ) +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 ) ENDDO - DEALLOCATE(OrcaFlex_DataData%Input) + DEALLOCATE(AeroDyn_DataData%Output) ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes) + CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(AeroDyn_DataData%Input) ENDIF - END SUBROUTINE FAST_DestroyOrcaFlex_Data +IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN + DEALLOCATE(AeroDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyAeroDyn_Data - SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OrcaFlex_Data), INTENT(IN) :: InData + TYPE(AeroDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -22363,7 +23153,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -22382,7 +23172,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22401,7 +23191,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22420,7 +23210,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22439,7 +23229,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22457,7 +23247,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22474,7 +23264,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22491,7 +23281,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22508,7 +23298,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22524,12 +23314,52 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22580,7 +23410,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22610,7 +23440,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22640,7 +23470,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22670,7 +23500,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22699,7 +23529,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22727,7 +23557,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22755,7 +23585,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22783,7 +23613,76 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22822,7 +23721,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22862,16 +23761,18 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackOrcaFlex_Data + END SUBROUTINE FAST_PackAeroDyn_Data - SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OutData + TYPE(AeroDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -22880,16 +23781,10 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -22936,7 +23831,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22980,7 +23875,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23024,7 +23919,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23068,7 +23963,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23109,7 +24004,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23149,7 +24044,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23189,7 +24084,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23229,7 +24124,103 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23283,7 +24274,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23305,483 +24296,157 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackOrcaFlex_Data + END SUBROUTINE FAST_UnPackAeroDyn_Data - SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData + SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData + TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) + CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) + CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) + CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_W_P, DstModuleMapTypeData%ED_P_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_ED_P, DstModuleMapTypeData%HD_W_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_P, DstModuleMapTypeData%ED_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_ED_P, DstModuleMapTypeData%HD_M_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_L, DstModuleMapTypeData%ED_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_ED_P, DstModuleMapTypeData%HD_M_L_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_Mooring_P, DstModuleMapTypeData%ED_P_2_Mooring_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_P_2_ED_P, DstModuleMapTypeData%Mooring_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_P, DstModuleMapTypeData%SD_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SD_P, DstModuleMapTypeData%HD_M_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_L, DstModuleMapTypeData%SD_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_SD_P, DstModuleMapTypeData%HD_M_L_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_N, DstModuleMapTypeData%ED_P_2_SrvD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_N, DstModuleMapTypeData%SrvD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_SrvD_P_T, DstModuleMapTypeData%ED_L_2_SrvD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_T, DstModuleMapTypeData%SrvD_P_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) + CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN - ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Output,1) + i1_u = UBOUND(SrcInflowWind_DataData%Output,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN + ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceF_P, DstModuleMapTypeData%SD_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SD_P_2_IceD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SD_P_2_IceD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Input,1) + i1_u = UBOUND(SrcInflowWind_DataData%Input,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN + ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceD_P(i1), DstModuleMapTypeData%SD_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN - ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh, DstModuleMapTypeData%u_ED_PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_2, DstModuleMapTypeData%u_ED_PlatformPtMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh, DstModuleMapTypeData%u_SD_LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh_2, DstModuleMapTypeData%u_SD_LMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_LumpedMesh, DstModuleMapTypeData%u_HD_M_LumpedMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_DistribMesh, DstModuleMapTypeData%u_HD_M_DistribMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_Mesh, DstModuleMapTypeData%u_HD_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) + i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN + ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyModuleMapType + END SUBROUTINE FAST_CopyInflowWind_Data - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData + SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -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 ) +DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) + CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat, ErrMsg ) 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 ) +DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) + CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat, ErrMsg ) 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 ) +DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) + CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) -ENDIF - 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_HD_M_L, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_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%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_M_L, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SrvD_P_N, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_N, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_SrvD_P_T, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_T, ErrStat, ErrMsg ) -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 ) +DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) + CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat, ErrMsg ) 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 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 ) +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 ) ENDDO - DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) + DEALLOCATE(InflowWind_DataData%Output) 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 InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat, ErrMsg ) +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 ) ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) + DEALLOCATE(InflowWind_DataData%Input) ENDIF - 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 ) -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 ) -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%SD_P_2_IceF_P, ErrStat, ErrMsg ) -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 ) -ENDDO - DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SD_P_2_IceD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_IceD_P(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModuleMapTypeData%SD_P_2_IceD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN - DEALLOCATE(ModuleMapTypeData%Jac_u_indx) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat, ErrMsg ) - 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_LumpedMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_DistribMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat, ErrMsg ) -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 ) -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 ) -ENDDO - DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) +IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN + DEALLOCATE(InflowWind_DataData%InputTimes) ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyModuleMapType + END SUBROUTINE FAST_DestroyInflowWind_Data - SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ModuleMapType), INTENT(IN) :: InData + TYPE(InflowWind_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -23796,7 +24461,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModuleMapType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInflowWind_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -23812,1441 +24477,17058 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackInflowWind_Data + + SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(InflowWind_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInflowWind_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackInflowWind_Data + + SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData + TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyOpenFOAM_Data + + SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + 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 ) + END SUBROUTINE FAST_DestroyOpenFOAM_Data + + SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(OpenFOAM_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOpenFOAM_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackOpenFOAM_Data + + SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackOpenFOAM_Data + + SUBROUTINE FAST_CopySuperController_Data( SrcSuperController_DataData, DstSuperController_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SuperController_Data), INTENT(IN) :: SrcSuperController_DataData + TYPE(SuperController_Data), INTENT(INOUT) :: DstSuperController_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySuperController_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL SC_CopyInput( SrcSuperController_DataData%u, DstSuperController_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyOutput( SrcSuperController_DataData%y, DstSuperController_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyParam( SrcSuperController_DataData%p, DstSuperController_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopySuperController_Data + + SUBROUTINE FAST_DestroySuperController_Data( SuperController_DataData, ErrStat, ErrMsg ) + TYPE(SuperController_Data), INTENT(INOUT) :: SuperController_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySuperController_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL SC_DestroyInput( SuperController_DataData%u, ErrStat, ErrMsg ) + CALL SC_DestroyOutput( SuperController_DataData%y, ErrStat, ErrMsg ) + CALL SC_DestroyParam( SuperController_DataData%p, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroySuperController_Data + + SUBROUTINE FAST_PackSuperController_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(SuperController_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSuperController_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackSuperController_Data + + SUBROUTINE FAST_UnPackSuperController_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(SuperController_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSuperController_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackSuperController_Data + + SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData + TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) + CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) + CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) + CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) + CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Input,1) + i1_u = UBOUND(SrcSubDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN + ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) + CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN + ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopySubDyn_Data + + SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) + CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) + CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) + CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) + CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(SubDyn_DataData%Input) +ENDIF +IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN + DEALLOCATE(SubDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroySubDyn_Data + + SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SubDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackSubDyn_Data + + SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SubDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackSubDyn_Data + + SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData + TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) + CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) + CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) + CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) + CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) + i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN + ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) + i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN + ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyExtPtfm_Data + + SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) + CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) + CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) + CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) + CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(ExtPtfm_DataData%Input) +ENDIF +IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN + DEALLOCATE(ExtPtfm_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyExtPtfm_Data + + SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ExtPtfm_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExtPtfm_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackExtPtfm_Data + + SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExtPtfm_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackExtPtfm_Data + + SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData + TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) + CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) + CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) + CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) + CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN + ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN + ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN + ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyHydroDyn_Data + + SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) + TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) + CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) + CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) + CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) + CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(HydroDyn_DataData%Output) +ENDIF + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(HydroDyn_DataData%Input) +ENDIF +IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN + DEALLOCATE(HydroDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyHydroDyn_Data + + SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(HydroDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackHydroDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackHydroDyn_Data + + SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(HydroDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackHydroDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackHydroDyn_Data + + SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData + TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) + CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) + CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) + CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) + CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%Input,1) + i1_u = UBOUND(SrcIceFloe_DataData%Input,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN + ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) + CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) + i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN + ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyIceFloe_Data + + SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) + TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) + CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) + CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) + CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) + CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(IceFloe_DataData%Input) +ENDIF +IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN + DEALLOCATE(IceFloe_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyIceFloe_Data + + SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(IceFloe_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceFloe_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackIceFloe_Data + + SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(IceFloe_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceFloe_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackIceFloe_Data + + SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData + TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) + CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) + CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) + CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMAP_DataData%Output)) THEN + i1_l = LBOUND(SrcMAP_DataData%Output,1) + i1_u = UBOUND(SrcMAP_DataData%Output,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN + ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) + CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMAP_DataData%Input)) THEN + i1_l = LBOUND(SrcMAP_DataData%Input,1) + i1_u = UBOUND(SrcMAP_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN + ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) + CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) + i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN + ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyMAP_Data + + SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) + TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) + CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) + CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) + CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(MAP_DataData%Output) +ENDIF + CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(MAP_DataData%Input) +ENDIF +IF (ALLOCATED(MAP_DataData%InputTimes)) THEN + DEALLOCATE(MAP_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyMAP_Data + + SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MAP_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMAP_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackMAP_Data + + SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MAP_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMAP_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackMAP_Data + + SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData + TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) + CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) + CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) + CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) + CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) + i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN + ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) + CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) + i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN + ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyFEAMooring_Data + + SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) + CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) + CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) + CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) + CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(FEAMooring_DataData%Input) +ENDIF +IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN + DEALLOCATE(FEAMooring_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyFEAMooring_Data + + SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FEAMooring_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackFEAMooring_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackFEAMooring_Data + + SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FEAMooring_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackFEAMooring_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackFEAMooring_Data + + SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData + TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) + CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) + CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) + CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) + CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN + ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) + CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN + ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyMoorDyn_Data + + SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) + TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) + CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) + CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) + CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) + CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(MoorDyn_DataData%Input) +ENDIF +IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN + DEALLOCATE(MoorDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyMoorDyn_Data + + SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MoorDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMoorDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackMoorDyn_Data + + SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MoorDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMoorDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackMoorDyn_Data + + SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData + TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) + CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) + CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) + CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) + CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN + ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) + CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN + ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyOrcaFlex_Data + + SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) + CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) + CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) + CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) + CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(OrcaFlex_DataData%Input) +ENDIF +IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN + DEALLOCATE(OrcaFlex_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyOrcaFlex_Data + + SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(OrcaFlex_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOrcaFlex_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackOrcaFlex_Data + + SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackOrcaFlex_Data + + SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN + ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_W_P, DstModuleMapTypeData%ED_P_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_ED_P, DstModuleMapTypeData%HD_W_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_P, DstModuleMapTypeData%ED_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_ED_P, DstModuleMapTypeData%HD_M_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_L, DstModuleMapTypeData%ED_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_ED_P, DstModuleMapTypeData%HD_M_L_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_Mooring_P, DstModuleMapTypeData%ED_P_2_Mooring_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_P_2_ED_P, DstModuleMapTypeData%Mooring_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_P, DstModuleMapTypeData%SD_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SD_P, DstModuleMapTypeData%HD_M_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_L, DstModuleMapTypeData%SD_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_SD_P, DstModuleMapTypeData%HD_M_L_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_N, DstModuleMapTypeData%ED_P_2_SrvD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_N, DstModuleMapTypeData%SrvD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_SrvD_P_T, DstModuleMapTypeData%ED_L_2_SrvD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_T, DstModuleMapTypeData%SrvD_P_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN + ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN + ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN + ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceF_P, DstModuleMapTypeData%SD_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN + ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%SD_P_2_IceD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%SD_P_2_IceD_P)) THEN + ALLOCATE(DstModuleMapTypeData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceD_P(i1), DstModuleMapTypeData%SD_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) + i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) + i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN + ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN + ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) + i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) + i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN + ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh, DstModuleMapTypeData%u_ED_PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_2, DstModuleMapTypeData%u_ED_PlatformPtMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh, DstModuleMapTypeData%u_SD_LMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh_2, DstModuleMapTypeData%u_SD_LMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_LumpedMesh, DstModuleMapTypeData%u_HD_M_LumpedMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_DistribMesh, DstModuleMapTypeData%u_HD_M_DistribMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_Mesh, DstModuleMapTypeData%u_HD_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN + ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN + ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyModuleMapType + + SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +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 ) +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 ) +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 ) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) +ENDIF + 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_HD_M_L, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_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%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_M_L, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_2_SD_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SrvD_P_N, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_N, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_SrvD_P_T, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_T, ErrStat, ErrMsg ) +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 ) +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 ) +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 ) +ENDDO + DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) +ENDIF + 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 ) +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 ) +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%SD_P_2_IceF_P, ErrStat, ErrMsg ) +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 ) +ENDDO + DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%SD_P_2_IceD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_IceD_P(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%SD_P_2_IceD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN + DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN + DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN + DEALLOCATE(ModuleMapTypeData%Jac_u_indx) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat, ErrMsg ) + 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_LumpedMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_HD_M_DistribMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_HD_Mesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat, ErrMsg ) +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 ) +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 ) +ENDDO + DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyModuleMapType + + SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ModuleMapType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModuleMapType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no + IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) + Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_W_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_W_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_W_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_W_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_W_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_L: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_L + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_L + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_L + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_Mooring_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_Mooring_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_Mooring_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_Mooring_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Mooring_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Mooring_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Mooring_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Mooring_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_L: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_L + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_L + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_L + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_N: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_N + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_N + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_N + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_N: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_N + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_N + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_N + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_L_2_SrvD_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_SrvD_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_SrvD_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_SrvD_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no + IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) + Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no + IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) + Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no + IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) + Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceF_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceF_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceF_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceF_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceF_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no + IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension + DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) + Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! SD_P_2_IceD_P allocated yes/no + IF ( ALLOCATED(InData%SD_P_2_IceD_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SD_P_2_IceD_P upper/lower bounds for each dimension + DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) + Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no + IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 + END IF + Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no + IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot + END IF + Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no + IF ( ALLOCATED(InData%Jac_u_indx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_2: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh_2: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh_2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh_2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh_2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_HD_M_LumpedMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_LumpedMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_LumpedMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_LumpedMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_LumpedMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_HD_M_DistribMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_DistribMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_DistribMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_DistribMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_DistribMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_HD_Mesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD_Mesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD_Mesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD_Mesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no + IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) + Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no + IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) + Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype + CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_PtfmMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BD_P_2_ED_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_P_2_ED_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P_Hub,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_W_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_AD_L_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BD_L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceF_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%IceD_P_2_SD_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IceD_P_2_SD_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SD_P_2_IceD_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SD_P_2_IceD_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SD_P_2_IceD_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jacobian_Opt1,2), UBOUND(InData%Jacobian_Opt1,2) + DO i1 = LBOUND(InData%Jacobian_Opt1,1), UBOUND(InData%Jacobian_Opt1,1) + ReKiBuf(Re_Xferred) = InData%Jacobian_Opt1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_pivot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Jacobian_pivot,1), UBOUND(InData%Jacobian_pivot,1) + IntKiBuf(Int_Xferred) = InData%Jacobian_pivot(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_LumpedMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_DistribMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%u_BD_RootMotion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD_RootMotion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) + CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BD_BldMotion_4Loads,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) + CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackModuleMapType + + SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModuleMapType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) + ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_P_2_ED_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) + ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P_Hub not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) + ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_W_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_W_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) + ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no - IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) + ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) + ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) + ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_W_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_W_P + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_W_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_W_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_W_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_ED_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SD_P_2_IceF_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) + ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_ED_P + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(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 ! SD_P_2_IceD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SD_P_2_IceD_P)) DEALLOCATE(OutData%SD_P_2_IceD_P) + ALLOCATE(OutData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SD_P_2_IceD_P,1), UBOUND(OutData%SD_P_2_IceD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_L + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SD_P_2_IceD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) + ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) + DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) + OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) + ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) + OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_ED_P + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_Mooring_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_Mooring_P + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_Mooring_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_Mooring_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_Mooring_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! Mooring_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_P_2_ED_P + CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Mooring_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mooring_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mooring_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP + CALL MeshUnpack( OutData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P + CALL MeshUnpack( OutData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_P + CALL MeshUnpack( OutData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_LumpedMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SD_P + CALL MeshUnpack( OutData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_DistribMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_L + CALL MeshUnpack( OutData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_Mesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_SD_P + CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_N + CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) + ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_N + CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) + ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_SrvD_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_SrvD_P_T + CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_SrvD_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(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 - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_SrvD_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_SrvD_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_T + CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B + CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no - IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackModuleMapType + + SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData + TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq + DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr + DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom + DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom + DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom + DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac + DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus + END SUBROUTINE FAST_CopyExternInputType + + SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE FAST_DestroyExternInputType + + SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ExternInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInputType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! GenTrq + Re_BufSz = Re_BufSz + 1 ! ElecPwr + Re_BufSz = Re_BufSz + 1 ! YawPosCom + Re_BufSz = Re_BufSz + 1 ! YawRateCom + Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom + Re_BufSz = Re_BufSz + 1 ! HSSBrFrac + Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HSSBrFrac + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) + ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FAST_PackExternInputType + + SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%BlPitchCom,1) + i1_u = UBOUND(OutData%BlPitchCom,1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%LidarFocus,1) + i1_u = UBOUND(OutData%LidarFocus,1) + DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) + OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FAST_UnPackExternInputType + + SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData + TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInitData' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ED_CopyInitInput( SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ED_CopyInitOutput( SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL BD_CopyInitInput( SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitDataData%OutData_BD)) THEN + i1_l = LBOUND(SrcInitDataData%OutData_BD,1) + i1_u = UBOUND(SrcInitDataData%OutData_BD,1) + IF (.NOT. ALLOCATED(DstInitDataData%OutData_BD)) THEN + ALLOCATE(DstInitDataData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitDataData%OutData_BD,1), UBOUND(SrcInitDataData%OutData_BD,1) + CALL BD_CopyInitOutput( SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL SrvD_CopyInitInput( SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyInitOutput( SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInitInput( SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInitOutput( SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInitInput( SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInitOutput( SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyInitInput( SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyInitOutput( SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInitInput( SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInitOutput( SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInitInput( SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInitOutput( SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInitInput( SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInitOutput( SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInitInput( SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInitOutput( SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInitInput( SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInitOutput( SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInitInput( SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInitOutput( SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInitInput( SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInitOutput( SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInitInput( SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInitOutput( SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceD_CopyInitInput( SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyInitInput( SrcInitDataData%InData_SC, DstInitDataData%InData_SC, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyInitOutput( SrcInitDataData%OutData_SC, DstInitDataData%OutData_SC, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyInitData + + SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) + TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + 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 (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 ) +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 SC_DestroyInitInput( InitDataData%InData_SC, ErrStat, ErrMsg ) + CALL SC_DestroyInitOutput( InitDataData%OutData_SC, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyInitData + + SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_InitData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInitData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! InData_ED: size of buffers for each call to pack subtype + CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L + IF(ALLOCATED(Re_Buf)) THEN ! InData_ED Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L + IF(ALLOCATED(Db_Buf)) THEN ! InData_ED Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L + IF(ALLOCATED(Int_Buf)) THEN ! InData_ED Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + Int_BufSz = Int_BufSz + 3 ! OutData_ED: size of buffers for each call to pack subtype + CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ED Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ED Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ED Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T + Int_BufSz = Int_BufSz + 3 ! InData_BD: size of buffers for each call to pack subtype + CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T + IF(ALLOCATED(Re_Buf)) THEN ! InData_BD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T + IF(ALLOCATED(Db_Buf)) THEN ! InData_BD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T + IF(ALLOCATED(Int_Buf)) THEN ! InData_BD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + Int_BufSz = Int_BufSz + 1 ! OutData_BD allocated yes/no + IF ( ALLOCATED(InData%OutData_BD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutData_BD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) + Int_BufSz = Int_BufSz + 3 ! OutData_BD: size of buffers for each call to pack subtype + CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R + IF(ALLOCATED(Re_Buf)) THEN ! OutData_BD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R + IF(ALLOCATED(Db_Buf)) THEN ! OutData_BD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R + IF(ALLOCATED(Int_Buf)) THEN ! OutData_BD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceF_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceF_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceF_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceF_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no - IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P + Int_BufSz = Int_BufSz + 3 ! InData_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P + IF(ALLOCATED(Re_Buf)) THEN ! InData_SrvD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P + IF(ALLOCATED(Db_Buf)) THEN ! InData_SrvD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P + IF(ALLOCATED(Int_Buf)) THEN ! InData_SrvD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SD_P_2_IceD_P allocated yes/no - IF ( ALLOCATED(InData%SD_P_2_IceD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SD_P_2_IceD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) - Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceD_P + Int_BufSz = Int_BufSz + 3 ! OutData_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceD_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SrvD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceD_P + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SrvD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceD_P + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SrvD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no - IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no - IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh + Int_BufSz = Int_BufSz + 3 ! InData_AD14: size of buffers for each call to pack subtype + CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_AD14 Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_AD14 Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_AD14 Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_2 + Int_BufSz = Int_BufSz + 3 ! OutData_AD14: size of buffers for each call to pack subtype + CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_2 + IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD14 Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_2 + IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD14 Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_2 + IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD14 Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh + Int_BufSz = Int_BufSz + 3 ! InData_AD: size of buffers for each call to pack subtype + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_AD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_AD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_AD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh + Int_BufSz = Int_BufSz + 3 ! OutData_AD: size of buffers for each call to pack subtype + CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh_2 + Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh_2 + IF(ALLOCATED(Re_Buf)) THEN ! InData_IfW Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh_2 + IF(ALLOCATED(Db_Buf)) THEN ! InData_IfW Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh_2 + IF(ALLOCATED(Int_Buf)) THEN ! InData_IfW Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_LumpedMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_LumpedMesh + Int_BufSz = Int_BufSz + 3 ! OutData_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_LumpedMesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IfW Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_LumpedMesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IfW Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_LumpedMesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IfW Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_DistribMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_DistribMesh + Int_BufSz = Int_BufSz + 3 ! InData_OpFM: size of buffers for each call to pack subtype + CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_DistribMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_OpFM Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_DistribMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_OpFM Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_DistribMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_OpFM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_Mesh + Int_BufSz = Int_BufSz + 3 ! OutData_OpFM: size of buffers for each call to pack subtype + CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_Mesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_OpFM Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_Mesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_OpFM Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_Mesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_OpFM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad + Int_BufSz = Int_BufSz + 3 ! InData_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad + IF(ALLOCATED(Re_Buf)) THEN ! InData_HD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad + IF(ALLOCATED(Db_Buf)) THEN ! InData_HD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad + IF(ALLOCATED(Int_Buf)) THEN ! InData_HD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 + Int_BufSz = Int_BufSz + 3 ! OutData_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 + IF(ALLOCATED(Re_Buf)) THEN ! OutData_HD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 + IF(ALLOCATED(Db_Buf)) THEN ! OutData_HD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 + IF(ALLOCATED(Int_Buf)) THEN ! OutData_HD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no - IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion + Int_BufSz = Int_BufSz + 3 ! InData_SD: size of buffers for each call to pack subtype + CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion + IF(ALLOCATED(Re_Buf)) THEN ! InData_SD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion + IF(ALLOCATED(Db_Buf)) THEN ! InData_SD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion + IF(ALLOCATED(Int_Buf)) THEN ! InData_SD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no - IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads + Int_BufSz = Int_BufSz + 3 ! OutData_SD: size of buffers for each call to pack subtype + CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh + Int_BufSz = Int_BufSz + 3 ! InData_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtPtfm Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtPtfm Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtPtfm Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh + Int_BufSz = Int_BufSz + 3 ! OutData_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtPtfm Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtPtfm Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_PtfmMesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtPtfm Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_P_2_ED_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_P_2_ED_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P_Hub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_ED_P + Int_BufSz = Int_BufSz + 3 ! InData_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_L + IF(ALLOCATED(Re_Buf)) THEN ! InData_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_Mooring_P + IF(ALLOCATED(Re_Buf)) THEN ! InData_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_P_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_MD: size of buffers for each call to pack subtype + CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP + IF(ALLOCATED(Re_Buf)) THEN ! InData_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_MD: size of buffers for each call to pack subtype + CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_Orca: size of buffers for each call to pack subtype + CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_P + IF(ALLOCATED(Re_Buf)) THEN ! InData_Orca + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_Orca + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_Orca + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_Orca: size of buffers for each call to pack subtype + CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SD_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_Orca + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_Orca + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_Orca + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_L + IF(ALLOCATED(Re_Buf)) THEN ! InData_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_SD_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_N + IF(ALLOCATED(Re_Buf)) THEN ! InData_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_N + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_SC: size of buffers for each call to pack subtype + CALL SC_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SC, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_SC + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_SC + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_SC + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_SC: size of buffers for each call to pack subtype + CALL SC_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SC, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SC + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SC + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SC + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, OnlySize ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25274,7 +41556,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_SrvD_P_T + CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25302,7 +41584,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_T + CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, OnlySize ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25330,18 +41612,18 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + IF ( .NOT. ALLOCATED(InData%OutData_BD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutData_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutData_BD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B + DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) + CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25371,18 +41653,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B + CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25410,20 +41681,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BD_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L + CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25451,9 +41709,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T + CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25481,7 +41737,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T + CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25505,22 +41761,11 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25548,9 +41793,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25578,7 +41821,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P + CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25606,7 +41849,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceF_P + CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25634,18 +41877,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IceD_P_2_SD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P + CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25673,20 +41905,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SD_P_2_IceD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SD_P_2_IceD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SD_P_2_IceD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceD_P + CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25714,54 +41933,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Jacobian_Opt1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Jacobian_Opt1))-1 ) = PACK(InData%Jacobian_Opt1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Jacobian_Opt1) - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Jacobian_pivot)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jacobian_pivot))-1 ) = PACK(InData%Jacobian_pivot,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jacobian_pivot) - END IF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) - END IF - CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh + CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, OnlySize ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25789,7 +41961,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_2 + CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25817,7 +41989,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_TPMesh + CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25845,7 +42017,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh + CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25873,7 +42045,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh_2 + CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25901,7 +42073,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_LumpedMesh + CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25929,7 +42101,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_DistribMesh + CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25957,7 +42129,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_Mesh + CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25985,7 +42157,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad + CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26013,7 +42185,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 + CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26041,18 +42213,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%u_BD_RootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD_RootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion + CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, OnlySize ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26080,20 +42241,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BD_BldMotion_4Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads + CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26121,9 +42269,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_PtfmMesh + CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26151,7 +42297,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_PtfmMesh + CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26175,574 +42321,207 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackModuleMapType - - SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModuleMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) - ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_P_2_ED_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) - ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P_Hub not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) - ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_W_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_L + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SC, ErrStat2, ErrMsg2, OnlySize ) ! InData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SC, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackInitData + + SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_InitData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInitData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26776,7 +42555,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL ED_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ED, ErrStat2, ErrMsg2 ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26816,7 +42595,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P + CALL ED_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ED, ErrStat2, ErrMsg2 ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26856,13 +42635,27 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P + CALL BD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_BD, ErrStat2, ErrMsg2 ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutData_BD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutData_BD)) DEALLOCATE(OutData%OutData_BD) + ALLOCATE(OutData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutData_BD,1), UBOUND(OutData%OutData_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26896,13 +42689,15 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_L + CALL BD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_BD(i1), ErrStat2, ErrMsg2 ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26936,7 +42731,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_SD_P + CALL SrvD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SrvD, ErrStat2, ErrMsg2 ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26976,7 +42771,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_N + CALL SrvD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SrvD, ErrStat2, ErrMsg2 ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27016,7 +42811,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_N + CALL AD14_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD14, ErrStat2, ErrMsg2 ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27056,7 +42851,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_SrvD_P_T + CALL AD14_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD14, ErrStat2, ErrMsg2 ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27096,27 +42891,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_T + CALL AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD, ErrStat2, ErrMsg2 ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) - ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27150,29 +42931,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL AD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD, ErrStat2, ErrMsg2 ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) - ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27206,29 +42971,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B + CALL InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IfW, ErrStat2, ErrMsg2 ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) - ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27262,15 +43011,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IfW, ErrStat2, ErrMsg2 ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27304,7 +43051,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T + CALL OpFM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_OpFM, ErrStat2, ErrMsg2 ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27344,27 +43091,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL OpFM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_OpFM, ErrStat2, ErrMsg2 ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27398,15 +43131,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL HydroDyn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_HD, ErrStat2, ErrMsg2 ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27440,7 +43171,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL HydroDyn_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_HD, ErrStat2, ErrMsg2 ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27480,7 +43211,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P + CALL SD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SD, ErrStat2, ErrMsg2 ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27520,27 +43251,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SD_P_2_IceF_P + CALL SD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SD, ErrStat2, ErrMsg2 ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) - ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27574,29 +43291,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P + CALL ExtPtfm_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SD_P_2_IceD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SD_P_2_IceD_P)) DEALLOCATE(OutData%SD_P_2_IceD_P) - ALLOCATE(OutData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SD_P_2_IceD_P,1), UBOUND(OutData%SD_P_2_IceD_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27630,90 +43331,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SD_P_2_IceD_P + CALL ExtPtfm_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) - ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jacobian_Opt1)>0) OutData%Jacobian_Opt1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Jacobian_Opt1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Jacobian_Opt1) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) - ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Jacobian_pivot)>0) OutData%Jacobian_pivot = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jacobian_pivot))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jacobian_pivot) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27747,7 +43371,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh + CALL MAP_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MAP, ErrStat2, ErrMsg2 ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27787,7 +43411,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 + CALL MAP_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MAP, ErrStat2, ErrMsg2 ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27827,7 +43451,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh + CALL FEAM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_FEAM, ErrStat2, ErrMsg2 ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27867,7 +43491,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh + CALL FEAM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_FEAM, ErrStat2, ErrMsg2 ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27907,7 +43531,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 + CALL MD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MD, ErrStat2, ErrMsg2 ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27947,7 +43571,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_LumpedMesh + CALL MD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MD, ErrStat2, ErrMsg2 ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27987,7 +43611,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_DistribMesh + CALL Orca_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_Orca, ErrStat2, ErrMsg2 ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28027,7 +43651,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_Mesh + CALL Orca_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_Orca, ErrStat2, ErrMsg2 ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28067,7 +43691,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad + CALL IceFloe_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceF, ErrStat2, ErrMsg2 ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28107,27 +43731,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 + CALL IceFloe_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceF, ErrStat2, ErrMsg2 ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) - ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28161,29 +43771,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion + CALL IceD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceD, ErrStat2, ErrMsg2 ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) - ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28217,15 +43811,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads + CALL IceD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceD, ErrStat2, ErrMsg2 ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28259,7 +43851,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh + CALL SC_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SC, ErrStat2, ErrMsg2 ) ! InData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28299,18 +43891,18 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh + CALL SC_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SC, ErrStat2, ErrMsg2 ) ! OutData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackModuleMapType + END SUBROUTINE FAST_UnPackInitData - SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData - TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData + SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(FAST_MiscVarType), INTENT(INOUT) :: DstMiscData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -28319,35 +43911,45 @@ SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeD INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMisc' ! ErrStat = ErrID_None ErrMsg = "" - DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq - DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr - DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom - DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom - DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom - DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac - DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus - END SUBROUTINE FAST_CopyExternInputType + DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn + DstMiscData%t_global = SrcMiscData%t_global + DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime + DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime + DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 + DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 + DstMiscData%StrtTime = SrcMiscData%StrtTime + DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime + DstMiscData%calcJacobian = SrcMiscData%calcJacobian + CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyMisc - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData + SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - END SUBROUTINE FAST_DestroyExternInputType + CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat, ErrMsg ) + CALL FAST_Destroymisclintype( MiscData%Lin, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyMisc - SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(IN) :: InData + TYPE(FAST_MiscVarType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -28362,7 +43964,7 @@ SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMisc' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -28378,13 +43980,50 @@ SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus + Db_BufSz = Db_BufSz + 1 ! TiLstPrn + Db_BufSz = Db_BufSz + 1 ! t_global + Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime + Re_BufSz = Re_BufSz + 1 ! PrevClockTime + Re_BufSz = Re_BufSz + 1 ! UsrTime1 + Re_BufSz = Re_BufSz + 1 ! UsrTime2 + Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime + Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime + Int_BufSz = Int_BufSz + 1 ! calcJacobian + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype + CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ExternInput + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ExternInput + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ExternInput + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype + CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Lin + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Lin + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Lin + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -28412,27 +44051,91 @@ SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidarFocus))-1 ) = PACK(InData%LidarFocus,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidarFocus) - END SUBROUTINE FAST_PackExternInputType + DbKiBuf(Db_Xferred) = InData%TiLstPrn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%t_global + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%NextJacCalcTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrevClockTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UsrTime1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UsrTime2 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StrtTime,1), UBOUND(InData%StrtTime,1) + IntKiBuf(Int_Xferred) = InData%StrtTime(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SimStrtTime,1), UBOUND(InData%SimStrtTime,1) + IntKiBuf(Int_Xferred) = InData%SimStrtTime(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%calcJacobian, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackMisc + + SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData + TYPE(FAST_MiscVarType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -28441,16 +44144,10 @@ SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMisc' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -28461,43 +44158,117 @@ SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidarFocus,1) - i1_u = UBOUND(OutData%LidarFocus,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LidarFocus = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidarFocus))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidarFocus) - DEALLOCATE(mask1) - END SUBROUTINE FAST_UnPackExternInputType + OutData%TiLstPrn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%t_global = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NextJacCalcTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PrevClockTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UsrTime1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UsrTime2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%StrtTime,1) + i1_u = UBOUND(OutData%StrtTime,1) + DO i1 = LBOUND(OutData%StrtTime,1), UBOUND(OutData%StrtTime,1) + OutData%StrtTime(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%SimStrtTime,1) + i1_u = UBOUND(OutData%SimStrtTime,1) + DO i1 = LBOUND(OutData%SimStrtTime,1), UBOUND(OutData%SimStrtTime,1) + OutData%SimStrtTime(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%calcJacobian = TRANSFER(IntKiBuf(Int_Xferred), OutData%calcJacobian) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackexterninputtype( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FAST_MiscVarType), INTENT(INOUT) :: DstMiscData + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackmisclintype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackMisc + + SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData + TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -28506,42 +44277,42 @@ SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInitType' ! ErrStat = ErrID_None ErrMsg = "" - DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn - DstMiscData%t_global = SrcMiscData%t_global - DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime - DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime - DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 - DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 - DstMiscData%StrtTime = SrcMiscData%StrtTime - DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime - DstMiscData%calcJacobian = SrcMiscData%calcJacobian - CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%NextLinTimeIndx = SrcMiscData%NextLinTimeIndx - END SUBROUTINE FAST_CopyMisc + DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax + DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType + DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel + DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID + DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl + DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC + DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration + DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n + DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta + DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero + DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName + DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade + DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower + END SUBROUTINE FAST_CopyExternInitType - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData + SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyMisc + END SUBROUTINE FAST_DestroyExternInitType - SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_MiscVarType), INTENT(IN) :: InData + TYPE(FAST_ExternInitType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -28556,7 +44327,7 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInitType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -28572,34 +44343,20 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! TiLstPrn - Db_BufSz = Db_BufSz + 1 ! t_global - Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime - Re_BufSz = Re_BufSz + 1 ! PrevClockTime - Re_BufSz = Re_BufSz + 1 ! UsrTime1 - Re_BufSz = Re_BufSz + 1 ! UsrTime2 - Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime - Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime - Int_BufSz = Int_BufSz + 1 ! calcJacobian - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExternInput - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExternInput - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExternInput - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx + Db_BufSz = Db_BufSz + 1 ! Tmax + Int_BufSz = Int_BufSz + 1 ! SensorType + 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 ! NumSC2Ctrl + Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC + Int_BufSz = Int_BufSz + 1 ! FarmIntegration + Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n + Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta + Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade + Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -28627,317 +44384,44 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TiLstPrn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%t_global - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%NextJacCalcTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrevClockTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UsrTime1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UsrTime2 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%StrtTime))-1 ) = PACK(InData%StrtTime,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%StrtTime) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SimStrtTime))-1 ) = PACK(InData%SimStrtTime,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SimStrtTime) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%calcJacobian , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackMisc - - SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TiLstPrn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%t_global = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NextJacCalcTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PrevClockTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%StrtTime,1) - i1_u = UBOUND(OutData%StrtTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%StrtTime = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%StrtTime))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%StrtTime) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%SimStrtTime,1) - i1_u = UBOUND(OutData%SimStrtTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SimStrtTime = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SimStrtTime))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SimStrtTime) - DEALLOCATE(mask1) - OutData%calcJacobian = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - 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 ) + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbineID + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%windGrid_n,1), UBOUND(InData%windGrid_n,1) + IntKiBuf(Int_Xferred) = InData%windGrid_n(i1) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) + END DO + DO i1 = LBOUND(InData%windGrid_delta,1), UBOUND(InData%windGrid_delta,1) + ReKiBuf(Re_Xferred) = InData%windGrid_delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%windGrid_pZero,1), UBOUND(InData%windGrid_pZero,1) + ReKiBuf(Re_Xferred) = InData%windGrid_pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpackexterninputtype( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NextLinTimeIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackMisc - - SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData - TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInitType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax - DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType - DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel - DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID - DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos - DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl - DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC - DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration - DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n - DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta - DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero - DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName - DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade - DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower - END SUBROUTINE FAST_CopyExternInitType - - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FAST_DestroyExternInitType - - SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInitType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInitType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! TurbineID - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TurbinePos))-1 ) = PACK(InData%TurbinePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TurbinePos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FarmIntegration , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%windGrid_n))-1 ) = PACK(InData%windGrid_n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%windGrid_n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%windGrid_delta))-1 ) = PACK(InData%windGrid_delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%windGrid_delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%windGrid_pZero))-1 ) = PACK(InData%windGrid_pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%windGrid_pZero) - 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:Int_Xferred+(1)-1 ) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackExternInitType SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -28953,12 +44437,6 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -28973,72 +44451,52 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 + OutData%TurbineID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TurbinePos,1) i1_u = UBOUND(OutData%TurbinePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TurbinePos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TurbinePos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TurbinePos) - DEALLOCATE(mask1) - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FarmIntegration = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = 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%windGrid_n,1) i1_u = UBOUND(OutData%windGrid_n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%windGrid_n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%windGrid_n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%windGrid_n,1), UBOUND(OutData%windGrid_n,1) + OutData%windGrid_n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%windGrid_delta,1) i1_u = UBOUND(OutData%windGrid_delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%windGrid_delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%windGrid_delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%windGrid_delta,1), UBOUND(OutData%windGrid_delta,1) + OutData%windGrid_delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%windGrid_pZero,1) i1_u = UBOUND(OutData%windGrid_pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%windGrid_pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%windGrid_pZero) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumActForcePtsBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumActForcePtsTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%windGrid_pZero,1), UBOUND(OutData%windGrid_pZero,1) + OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackExternInitType SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -29574,8 +45032,8 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbID - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbID + Int_Xferred = Int_Xferred + 1 CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, OnlySize ) ! p_FAST CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -30179,12 +45637,6 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackTurbineType' @@ -30198,8 +45650,8 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TurbID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TurbID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN diff --git a/modules/openfast-library/src/OutListParameters.xlsx b/modules/openfast-library/src/OutListParameters.xlsx deleted file mode 100644 index 7272d92cc5..0000000000 Binary files a/modules/openfast-library/src/OutListParameters.xlsx and /dev/null differ diff --git a/modules/openfast-registry/src/Makefile b/modules/openfast-registry/src/Makefile deleted file mode 100644 index 921149cd0e..0000000000 --- a/modules/openfast-registry/src/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -ifeq ($(OS),Windows_NT) - ifeq ($(OSTYPE),cygwin) - RM=rm -f - else - RM=del - endif -else - RM = rm -f -endif -.SUFFIXES: .c .o - -# i586-mingw32msvc-gcc -#CC_TOOLS = i586-mingw32msvc-gcc -CC_TOOLS = gcc -DEST_DIR = .. -CFLAGS = #-ansi -LDFLAGS = -DEBUG = -g -OBJ = registry.o \ - my_strtok.o \ - reg_parse.o \ - data.o \ - type.o \ - misc.o \ - sym.o \ - symtab_gen.o \ - gen_module_files.o \ - gen_c_types.o - -# marco's: all : $(OBJ) -$(DEST_DIR)/registry.exe : $(OBJ) - $(CC_TOOLS) -o $(DEST_DIR)/registry.exe $(DEBUG) $(LDFLAGS) $(OBJ) - -.c.o : - $(CC_TOOLS) $(CFLAGS) -c $(DEBUG) $< - -clean clena: - $(RM) $(OBJ) gen_comms.c standard.o - -superclean : clean - $(RM) $(DEST_DIR)/registry.exe Registry_tmp.* - -# regenerate this list with "makedepend -Y *.c" - -# DO NOT DELETE THIS LINE -- make depend depends on it. - -gen_module_files.o: protos.h registry.h data.h FAST_preamble.h type.o - -data.o: registry.h protos.h data.h -gen_allocs.o: protos.h registry.h data.h -gen_args.o: protos.h registry.h data.h -gen_scalar_derefs.o: protos.h registry.h data.h -gen_config.o: protos.h registry.h data.h -gen_defs.o: protos.h registry.h data.h -gen_mod_state_descr.o: protos.h registry.h data.h -gen_model_data_ord.o: protos.h registry.h data.h -gen_scalar_indices.o: protos.h registry.h data.h -gen_wrf_io.o: protos.h registry.h data.h -misc.o: protos.h registry.h data.h -my_strtok.o: registry.h protos.h data.h -reg_parse.o: registry.h protos.h data.h -registry.o: protos.h registry.h data.h Template_data.c Template_registry.c -sym.o: sym.h -type.o: registry.h protos.h data.h -gen_interp.o: registry.h protos.h data.h -gen_streams.o: registry.h protos.h data.h -gen_c_types.o: registry.h protos.h data.h diff --git a/modules/openfast-registry/src/Template_data.c b/modules/openfast-registry/src/Template_data.c index f363319ceb..22aa731e7e 100644 --- a/modules/openfast-registry/src/Template_data.c +++ b/modules/openfast-registry/src/Template_data.c @@ -165,7 +165,8 @@ char *template_data[] = { "", " ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here:", " ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u", -" ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u, InitOut%IsLoad_u", +" ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u", +" ! Allocate and set these variables: InitOut%IsLoad_u, InitOut%DerivOrder_x", "", " end if", "", diff --git a/modules/openfast-registry/src/Template_registry.c b/modules/openfast-registry/src/Template_registry.c index e4566b762a..e06dc7dcad 100644 --- a/modules/openfast-registry/src/Template_registry.c +++ b/modules/openfast-registry/src/Template_registry.c @@ -36,6 +36,7 @@ char *template_registry[] = { "#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - \"Flag that tells FAST if the constraint states used in linearization are in the rotating frame\" -", "#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - \"Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame\" -", "#typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - \"Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrices)\" -", +"#typedef ^ InitOutputType IntKi DerivOrder_x {:} - - \"Integer that tells FAST/MBC3 the order derivative for the continuous states used in linearization\" -", "", "", "# ..... States ....................................................................................................................", diff --git a/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h index 80c0101bd9..bc81980c73 100644 --- a/modules/openfast-registry/src/data.h +++ b/modules/openfast-registry/src/data.h @@ -37,7 +37,7 @@ typedef struct node_struct { /* CTRL */ - int gen_wrapper ; + int gen_periodic ; struct node_struct * next ; /* fields used by rconfig nodes */ diff --git a/modules/openfast-registry/src/gen_c_types.c b/modules/openfast-registry/src/gen_c_types.c index 1e329624ce..74bd14d662 100644 --- a/modules/openfast-registry/src/gen_c_types.c +++ b/modules/openfast-registry/src/gen_c_types.c @@ -377,7 +377,10 @@ gen_c_module( FILE * fph, node_t * ModName ) fprintf(fph," %s * %s ; ",C_type( r->type->mapsto), r->name ) ; fprintf(fph," int %s_Len ;",r->name ) ; } else { - char *p = r->type->mapsto, buf[10]; + char *p = r->type->mapsto; + char buf[10]; +// bjj: this assumes all character strings are defined with numeric lengths +// It should be modified to allow use of parameters, too. (and parameters defined in the registry should also be defined in the .h file) while (*p) { if (isdigit(*p)) { long val = strtol(p, &p, 10); @@ -385,6 +388,8 @@ gen_c_module( FILE * fph, node_t * ModName ) } else { p++; } + + } if (strcmp(C_type(r->type->mapsto), "char") == 0 ){ // if it's a char we need to add the array size if (r->ndims == 0) diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c index 84f912c9ba..7e44d315f6 100644 --- a/modules/openfast-registry/src/gen_module_files.c +++ b/modules/openfast-registry/src/gen_module_files.c @@ -33,13 +33,20 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg )\n", ModName->nickname, nonick,nonick ); + fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick,nonick ); fprintf(fp," TYPE(%s), INTENT(INOUT) :: %sData\n" , addnick, nonick ); fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n" ); fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n" ); + fprintf(fp," LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n" ); fprintf(fp," ! \n" ); + fprintf(fp," LOGICAL :: SkipPointers_local\n"); fprintf(fp," ErrStat = ErrID_None\n" ); - fprintf(fp," ErrMsg = \"\"\n" ); + fprintf(fp," ErrMsg = \"\"\n\n" ); + fprintf(fp," IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp," SkipPointers_local = SkipPointers\n"); + fprintf(fp," ELSE\n"); + fprintf(fp," SkipPointers_local = .false.\n"); + fprintf(fp," END IF\n"); sprintf(tmp,"%s",addnick) ; @@ -55,11 +62,13 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to } else { if ( is_pointer(r) ) { fprintf(fp,"\n ! -- %s %s Data fields\n",r->name,nonick) ; - fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; - fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; - fprintf(fp," ELSE\n") ; - fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; - fprintf(fp," END IF\n") ; + fprintf(fp," IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; + fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; + fprintf(fp," ELSE\n") ; + fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; + fprintf(fp," END IF\n") ; + fprintf(fp, " END IF\n"); } else if (!has_deferred_dim(r, 0)) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || @@ -86,6 +95,87 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to return(0) ; } +int +gen_copy_f2c(FILE *fp, // *.f90 file we are writting to + const node_t *ModName, // module name + char *inout, // character string written out + char *inoutlong) // not sure what this is used for +{ + node_t *q, *r; + char tmp[NAMELEN]; + char addnick[NAMELEN]; + char nonick[NAMELEN]; + + remove_nickname(ModName->nickname, inout, nonick); + append_nickname((is_a_fast_interface_type(inoutlong)) ? ModName->nickname : "", inoutlong, addnick); + fprintf(fp, " SUBROUTINE %s_F2C_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick, nonick); + fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n", addnick, nonick); + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"); + fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); + fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"); + fprintf(fp, " ! \n"); + fprintf(fp, " LOGICAL :: SkipPointers_local\n"); + fprintf(fp, " ErrStat = ErrID_None\n"); + fprintf(fp, " ErrMsg = \"\"\n\n"); + fprintf(fp, " IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp, " SkipPointers_local = SkipPointers\n"); + fprintf(fp, " ELSE\n"); + fprintf(fp, " SkipPointers_local = .false.\n"); + fprintf(fp, " END IF\n"); + + sprintf(tmp, "%s", addnick); + + if ((q = get_entry(make_lower_temp(tmp), ModName->module_ddt_list)) == NULL) + { + fprintf(stderr, "Registry warning: generating %s_F2C_Copy%s: cannot find definition for %s\n", ModName->nickname, nonick, tmp); + } + else { + for (r = q->fields; r; r = r->next) + { + if (r->type != NULL) { + if (r->type->type_type == DERIVED) { // && ! r->type->usefrom + fprintf(stderr, "Registry WARNING: derived data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + } + else { + if (is_pointer(r)) { + fprintf(fp, "\n ! -- %s %s Data fields\n", r->name, nonick); + fprintf(fp, " IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp, " IF ( .NOT. %s(%sData%%%s)) THEN \n", assoc_or_allocated(r), nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s_Len = 0\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_NULL_PTR\n", nonick, r->name); + fprintf(fp, " ELSE\n"); + fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); + fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s( LBOUND(%sData%%%s,1) ) ) \n", nonick, r->name, nonick, r->name, nonick, r->name ); + fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n"); + } + else if (!has_deferred_dim(r, 0)) { + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)") || + !strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)") || + !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + !strcmp(r->type->mapsto, "LOGICAL")) + { + fprintf(fp, " %sData%%C_obj%%%s = %sData%%%s\n", nonick, r->name, nonick, r->name); + } + else { // characters need to be copied differently + if (r->ndims == 0) { + //fprintf(stderr, "Registry WARNING: character data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + fprintf(fp, " %sData%%C_obj%%%s = TRANSFER(%sData%%%s, %sData%%C_obj%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); + } + } + } + } + } + } + } + + fprintf(fp, " END SUBROUTINE %s_F2C_Copy%s\n\n", ModName->nickname, nonick); + return(0); +} + int gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, const node_t * q_in ) @@ -190,13 +280,14 @@ gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, con fprintf(fp, " Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; if (sw_ccode && !is_pointer(r)){ - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL") || - r->ndims == 0) + //if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + // !strcmp(r->type->mapsto, "REAL(SiKi)") || + // !strcmp(r->type->mapsto, "REAL(DbKi)") || + // !strcmp(r->type->mapsto, "REAL(R8Ki)") || + // !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + // !strcmp(r->type->mapsto, "LOGICAL") || + // r->ndims == 0) + if ( r->ndims == 0 ) // scalar of any type OR a character array { // fprintf(fp, " Dst%sData%%C_obj%%%s = Dst%sData%%%s\n", nonick, r->name, nonick, r->name); fprintf(fp, " Dst%sData%%C_obj%%%s = Src%sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); @@ -221,10 +312,10 @@ void gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - char nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; + char nonick2[NAMELEN], indent[NAMELEN], mainIndent[6]; node_t *q, * r ; - int frst, d; + int frst, d, i; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -416,26 +507,26 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) for ( r = q->fields ; r ; r = r->next ) { - if (has_deferred_dim(r, 0)){ - // store whether the data type is allocated and the bounds of each dimension - fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - } - fprintf(fp, "\n"); - sprintf(tmp3, " IF (SIZE(InData%%%s)>0)", r->name); - } - else{ - sprintf(tmp3, " "); + if (has_deferred_dim(r, 0)) { + // store whether the data type is allocated and the bounds of each dimension + fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); + //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); + fprintf(fp, " ELSE\n"); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + for (d = 1; d <= r->ndims; d++) { + fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); + } + fprintf(fp, "\n"); + strcpy(mainIndent, " "); + } + else { + strcpy(mainIndent, ""); } @@ -500,63 +591,55 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) } } - else { // intrinsic data types + else { + // intrinsic data types // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(InData%%%s)", r->name); + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, " %s ReKiBuf ( Re_Xferred:Re_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s ReKiBuf(Re_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " %s DbKiBuf ( Db_Xferred:Db_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s DbKiBuf(Db_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+%s-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s)\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1"); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = TRANSFER(InData%%%s%s, IntKiBuf(1))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } + fprintf(fp, "%s DO I = 1, LEN(InData%%%s)\n", indent, r->name); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - fprintf(fp, " DO I = 1, LEN(InData%%%s)\n", r->name); - fprintf(fp, " IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + } - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n",d); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); } + fprintf(fp, "%s END DO\n", indent); + } -// bjj: this works, but will produce errors about the source being smaller than the result, thus leaving garbage in some bytes -#if 0 - fprintf(fp, " IntKiBuf ( Int_Xferred:Int_Xferred+%s*LEN(InData%%%s)-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s*LEN(InData%%%s))\n", - (r->ndims>0) ? tmp2 : "1", r->name, - (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + %s*LEN(InData%%%s)\n", (r->ndims>0) ? tmp2 : "1", r->name); -#endif - } /* - else - { - fprintf(fp, "! missing buffer for %s\n", r->name); - }*/ } if (has_deferred_dim(r, 0)){ @@ -571,9 +654,9 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) void gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], indent[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN], mainIndent[6]; node_t *q, * r ; - int d ; + int d, i ; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -599,12 +682,6 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp," INTEGER(IntKi) :: Db_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: Int_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: i\n") ; - fprintf(fp," LOGICAL :: mask0\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask1(:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask2(:,:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask3(:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask4(:,:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:)\n") ; for (d = 1; d <= q->max_ndims; d++){ fprintf(fp," INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); } @@ -659,18 +736,16 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) 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); } - - sprintf(tmp3, " IF (SIZE(OutData%%%s)>0)", r->name); + strcpy(mainIndent, " "); } else{ - sprintf(tmp3, " "); - for (d = 1; d <= r->ndims; d++) { fprintf(fp, " i%d_l = LBOUND(OutData%%%s,%d)\n", d, r->name, d); fprintf(fp, " i%d_u = UBOUND(OutData%%%s,%d)\n", d, r->name, d); sprintf(tmp2, ",i%d_l:i%d_u", d, d); strcat(tmp, tmp2); } + strcpy(mainIndent, ""); } if (!strcmp(r->type->name, "meshtype") || @@ -751,122 +826,73 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) } } - else if (r->ndims > 0){ //non-scalar intrinsic data types (arrays) - fprintf(fp, " ALLOCATE(mask%d(%s),STAT=ErrStat2)\n", r->ndims, (char*)&(tmp[1])); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating mask%d.', ErrStat, ErrMsg,RoutineName)\n", r->ndims); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " mask%d = .TRUE. \n", r->ndims); + else + { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } - // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(OutData%%%s)", r->name); - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), C_FLOAT)\n", - tmp3, r->name, tmp2, r->ndims); + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), SiKi)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi )\n", - tmp3, r->name, tmp2, r->ndims); + fprintf(fp, "%s OutData%%%s%s = ReKiBuf(Re_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), SiKi)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), C_DOUBLE)\n", - tmp3, r->name, tmp2, r->ndims); + else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), R8Ki)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi )\n", - tmp3, r->name, (r->ndims > 0) ? tmp2 : "1", r->ndims); + fprintf(fp, "%s OutData%%%s%s = DbKiBuf(Db_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), R8Ki)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " %s OutData%%%s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0_IntKi )\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = IntKiBuf(Int_Xferred)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL")) { - //fprintf(fp, " %s OutData%%%s = TRANSFER( UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0 ), OutData%%%s)\n", - fprintf(fp, " %s OutData%%%s = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), OutData%%%s), mask%d,.TRUE.)\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->name, r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = TRANSFER(IntKiBuf(Int_Xferred), OutData%%%s%s)\n", indent, r->name, dimstr(r->ndims), r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", d, r->name, d, r->name, d); - } + else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */ { - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + fprintf(fp, "%s DO I = 1, LEN(OutData%%%s)\n", indent, r->name); + fprintf(fp, "%s OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n", d); - } } - fprintf(fp, " DEALLOCATE(mask%d)\n", r->ndims); - - } - else { - // scalar intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - fprintf(fp, " OutData%%%s = ReKiBuf( Re_Xferred )\n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " OutData%%%s = REAL( ReKiBuf( Re_Xferred ), SiKi) \n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - fprintf(fp, " OutData%%%s = DbKiBuf( Db_Xferred ) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " OutData%%%s = REAL( DbKiBuf( Db_Xferred ), R8Ki) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " OutData%%%s = IntKiBuf( Int_Xferred ) \n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "LOGICAL")) { - fprintf(fp, " OutData%%%s = TRANSFER( IntKiBuf( Int_Xferred ), mask0 )\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); } -// need to move this (scalars and strings) to the %c_obj% type, too! +// need to move scalars and strings to the %c_obj% type, too! // compare with copy routine - if (sw_ccode && !has_deferred_dim(r, 0)) { + + if (sw_ccode && !is_pointer(r) && r->ndims == 0) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(DbKi)") || @@ -877,9 +903,7 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " OutData%%C_obj%%%s = OutData%%%s\n", r->name, r->name); } else { // characters need to be copied differently - if (r->ndims == 0){ - fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); - } + fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); } } @@ -1000,7 +1024,7 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, node_t *q, *r1 ; int j ; int mesh = 0 ; - char derefrecurse[NAMELEN],dex[NAMELEN],tmp[NAMELEN] ; + char derefrecurse[NAMELEN],tmp[NAMELEN] ; if ( recurselevel > MAXRECURSE ) { fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; exit(9) ; @@ -1028,24 +1052,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } } } else if ( !strcmp( r->type->mapsto, "MeshType" ) ) { - strcpy(dex,"") ; for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; - sprintf(tmp,"i%d%d",0,j) ; - if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); } if ( order == 0 ) { - fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 1 ) { fprintf(fp," CALL MeshExtrapInterp1(%s(1)%s%%%s%s, %s(2)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 2 ) { fprintf(fp," CALL MeshExtrapInterp2(%s(1)%s%%%s%s, %s(2)%s%%%s%s, %s(3)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1058,19 +1077,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, char nonick2[NAMELEN] ; remove_nickname(r->type->module->nickname,r->type->name,nonick2) ; - strcpy(dex,"") ; + strcpy(dimstr(r->ndims),"") ; for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); + if ( j == r->ndims ) strcat(dimstr(r->ndims),"(") ; sprintf(tmp,"i%d%d",0,j) ; if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + strcat(dimstr(r->ndims),tmp) ; } fprintf(fp," CALL %s_%s_ExtrapInterp( %s%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname,fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1139,9 +1158,9 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, #endif void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { node_t *q, *r1; - int j; + int i, j; int mesh = 0; - char derefrecurse[NAMELEN], dex[NAMELEN], tmp[NAMELEN]; + char derefrecurse[NAMELEN], indent[NAMELEN], tmp[NAMELEN]; if (recurselevel > MAXRECURSE) { fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); exit(9); @@ -1155,17 +1174,28 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } if (r->type->type_type == DERIVED) { - - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { for (r1 = q->fields; r1; r1 = r1->next) { sprintf(derefrecurse, "%s%%%s", deref, r->name); - for (j = r->ndims; j > 0; j--) { + for (j = r->ndims; j > 0; j--) { fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - sprintf(derefrecurse, "%s%%%s(i%d%d)", deref, r->name, recurselevel, j); } + + + if (r->ndims > 0) { + strcat(derefrecurse, "("); + for (j = 1; j <= r->ndims; j++) { + sprintf(tmp, "i%d%d", recurselevel, j); + strcat(derefrecurse, tmp); + if (j < r->ndims) { + strcat(derefrecurse, ","); + } + } + strcat(derefrecurse, ")"); + } + gen_extint_order(fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel + 1); for (j = r->ndims; j > 0; j--) { fprintf(fp, " ENDDO\n"); @@ -1175,27 +1205,22 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, else { - strcpy(dex, ""); for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if (j == r->ndims) strcat(dex, "("); - sprintf(tmp, "i%d%d", 0, j); - if (j == 1) strcat(tmp, ")"); else strcat(tmp, ","); - strcat(dex, tmp); + fprintf(fp, " DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", j, uy, deref, r->name, j, uy, deref, r->name, j); } if (!strcmp(r->type->mapsto, "MeshType")) { if (order == 0) { - fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL MeshExtrapInterp1(%s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL MeshExtrapInterp2(%s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } else { @@ -1204,17 +1229,17 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, if (order == 0) { fprintf(fp, " CALL %s_Copy%s(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL %s_%s_ExtrapInterp1( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL %s_%s_ExtrapInterp2( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } @@ -1230,67 +1255,59 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (r->ndims == 0) { - } - else if (r->ndims == 1 && order > 0) { - fprintf(fp, " ALLOCATE(b1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - } - else if (r->ndims == 2 && order > 0) { - fprintf(fp, " ALLOCATE(b2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 3 && order > 0) { - fprintf(fp, " ALLOCATE(b3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - } - else if (r->ndims == 4 && order > 0) { - fprintf(fp, " ALLOCATE(b4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 5 && order > 0) { - fprintf(fp, " ALLOCATE(b5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - } - else { - if (order > 0) fprintf(stderr, "Registry WARNING: too many dimensions for %s%%%s\n", deref, r->name); - } + if (order == 0) { + //bjj: this should probably have some "IF ALLOCATED" statements around it, but we're just calling + // the copy routine fprintf(fp, " %s_out%s%%%s = %s1%s%%%s\n", uy, deref, r->name, uy, deref, r->name); } - else if (order == 1) { - fprintf(fp, " b%d = -(%s1%s%%%s - %s2%s%%%s)/t(2)\n", r->ndims, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out\n", uy, deref, r->name, uy, deref, r->name, r->ndims); - } - else if (order == 2) { - fprintf(fp, " b%d = (t(3)**2*(%s1%s%%%s - %s2%s%%%s) + t(2)**2*(-%s1%s%%%s + %s3%s%%%s))/(t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " c%d = ( (t(2)-t(3))*%s1%s%%%s + t(3)*%s2%s%%%s - t(2)*%s3%s%%%s ) / (t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out + c%d * t_out**2\n" - , uy, deref, r->name, uy, deref, r->name, r->ndims, r->ndims); - } - if (r->ndims >= 1 && order > 0) { - fprintf(fp, " DEALLOCATE(b%d)\n", r->ndims); - fprintf(fp, " DEALLOCATE(c%d)\n", r->ndims); + else + strcpy(indent, ""); + for (j = r->ndims; j > 0; j--) { + fprintf(fp, "%s DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", indent, j, uy, deref, r->name, j, uy, deref, r->name, j); + strcat(indent, " "); //create an indent + } + + if (order == 1) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = -(%s1%s%%%s%s - %s2%s%%%s%s)\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b * ScaleFactor\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + }; + } + if (order == 2) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = (t(3)**2*(%s1%s%%%s%s - %s2%s%%%s%s) + t(2)**2*(-%s1%s%%%s%s + %s3%s%%%s%s))* scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s c = ( (t(2)-t(3))*%s1%s%%%s%s + t(3)*%s2%s%%%s%s - t(2)*%s3%s%%%s%s ) * scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b + c * t_out\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + } + for (j = r->ndims; j >= 1; j--) { + strcpy(indent, ""); + for (i = 1; i < j; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); + } } - } // check if this is an allocatable array: if (r->ndims > 0 && has_deferred_dim(r, 0)) { fprintf(fp, "END IF ! check if allocated\n"); } - } -} + +} // gen_extint_order void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recurselevel, int *max_ndims, int *max_nrecurs, int *max_alloc_ndims) { node_t *q, *r1 ; @@ -1327,6 +1344,7 @@ void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recursele !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { if (/*order > 0 &&*/ r->ndims > *max_alloc_ndims) *max_alloc_ndims = r->ndims; + if (r->ndims > *max_ndims)* max_ndims = r->ndims; } @@ -1574,30 +1592,8 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp1'\n", ModName->nickname, typnm); - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); for (j = 1; j <= max_ndims; j++) { @@ -1605,6 +1601,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); @@ -1618,8 +1617,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + fprintf(fp, " ScaleFactor = t_out / t(2)\n"); for (r = q->fields; r; r = r->next) { @@ -1654,45 +1654,23 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, "!..................................................................................................................................\n"); fprintf(fp, "\n"); - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); + + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" ); fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); fprintf(fp, " ! local variables\n"); fprintf(fp, " REAL(%s) :: t(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp2'\n", ModName->nickname, typnm); @@ -1701,6 +1679,9 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); fprintf(fp, " ErrMsg = \"\"\n"); @@ -1720,7 +1701,11 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + + fprintf(fp, " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"); + + for (r = q->fields; r; r = r->next) { @@ -2256,6 +2241,7 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) gen_unpack( fp, ModName, ddtname, ddtnamelong ) ; if ( sw_ccode ) { gen_copy_c2f( fp, ModName, ddtname, ddtnamelong ) ; + gen_copy_f2c(fp, ModName, ddtname, ddtnamelong); } } @@ -2390,6 +2376,15 @@ char * dimstr( int d ) retval = " REGISTRY ERROR TOO MANY DIMS " ; } return(retval) ; + + //strcpy(dex, ""); + //strcat(dex, "("); + //for (j = 1; j <= d; j++) { + // sprintf(tmp, "i%d%d", 0, j); + // strcat(dex, tmp); + // if (j == d) strcat(dex, ")"); else strcat(dex, ","); + //} + } char * dimstr_c( int d ) diff --git a/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c index 0ec9f3c7db..37d457abc2 100644 --- a/modules/openfast-registry/src/reg_parse.c +++ b/modules/openfast-registry/src/reg_parse.c @@ -95,7 +95,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) // See if it might be in the current directory sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space + *p2 = '\0' ; // drop tailing white space if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } @@ -269,7 +269,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) -normal: +//normal: /* otherwise output the line as is */ fprintf(outfile,"%s\n",parseline_save) ; parseline[0] = '\0' ; /* reset parseline */ @@ -284,8 +284,8 @@ reg_parse( FILE * infile ) /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */ char inln[INLN_SIZE], parseline[PARSELINE_SIZE] ; char *p ; - char *tokens[MAXTOKENS], *ditto[MAXTOKENS] ; - int i ; + char *tokens[MAXTOKENS],*ditto[MAXTOKENS] ; + int i ; int defining_state_field, defining_rconfig_field, defining_i1_field ; parseline[0] = '\0' ; @@ -449,7 +449,6 @@ reg_parse( FILE * infile ) strcpy(field_struct->units,"-") ; if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } - #ifdef OVERSTRICT if ( field_struct->type != NULL ) if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) @@ -615,27 +614,19 @@ set_dim_len ( char * dimspec , node_t * dim_entry ) int set_ctrl( char *ctrl , node_t * field_struct ) -// process CTRL keys -- only 'h' (hidden) and 'e' (exposed). Default is not to generate a wrapper, -// so something must be specified, either h or e +// process CTRL keys -- only '2pi' (interpolation of values with 2pi period). Default is no special interpolation. { - char prev = '\0' ; - char x ; char tmp[NAMELEN] ; char *p ; - int i ; strcpy(tmp,ctrl) ; if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; } - for ( i = 0 ; i < strlen(tmp) ; i++ ) - { - x = tolower(tmp[i]) ; - if ( x == 'h' ) { - field_struct->gen_wrapper = WRAP_HIDDEN_FIELD ; - } else if ( x == 'e' ) { - field_struct->gen_wrapper = WRAP_EXPOSED_FIELD ; - } else { - field_struct->gen_wrapper = WRAP_NONE ; /* default */ - } + if (!strcmp(make_lower_temp(tmp), "2pi")) { + field_struct->gen_periodic = PERIOD_2PI; + } + else { + field_struct->gen_periodic = PERIOD_NONE; } + return(0) ; } diff --git a/modules/openfast-registry/src/registry.h b/modules/openfast-registry/src/registry.h index 0356025fb2..524bbe7e1a 100644 --- a/modules/openfast-registry/src/registry.h +++ b/modules/openfast-registry/src/registry.h @@ -23,9 +23,9 @@ enum type_type { SIMPLE , DERIVED } ; enum proc_orient { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ; /* wrapping options */ -#define WRAP_HIDDEN_FIELD 2 -#define WRAP_EXPOSED_FIELD 1 -#define WRAP_NONE 0 +#define PERIOD_2PI 2 +#define PERIOD_OTHER 1 +#define PERIOD_NONE 0 /* node_kind mask settings */ diff --git a/modules/openfoam/src/OpenFOAM.f90 b/modules/openfoam/src/OpenFOAM.f90 index 2e004a541f..807f2644ba 100644 --- a/modules/openfoam/src/OpenFOAM.f90 +++ b/modules/openfoam/src/OpenFOAM.f90 @@ -59,9 +59,7 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD14, u_AD, initOut_AD, y_AD, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: NMappings ! number of blades INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: j ! node counter INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -457,7 +455,6 @@ SUBROUTINE SetOpFMForces(p_FAST, p_AD14, u_AD14, y_AD14, u_AD, y_AD, y_ED, OpFM, ! Local variables: - REAL(ReKi ) :: factor ! scaling factor to get normalized forces for OpenFOAM REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive blade force nodes REAL(ReKi) :: dHforceNodes ! Uniform distance between two consecutive tower force nodes @@ -1018,7 +1015,7 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes REAL(ReKi), DIMENSION(:), ALLOCATABLE :: rStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i,j,k ! Loop variables + INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes @@ -1049,25 +1046,33 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, END SUBROUTINE CalcForceActuatorPositionsBlade !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat2, ErrMsg2) +SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat, ErrMsg) TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! data for the OpenFOAM integration module TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! data for the OpenFOAM integration module REAL(ReKi), POINTER :: structPositions(:,:) ! structural model positions REAL(ReKi), INTENT(INOUT) :: forceNodePositions(:,:) ! Array to store the newly created positions - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + INTEGER(IntKi) , intent(out) :: ErrStat ! temporary Error status of the operation + CHARACTER(ErrMsgLen) , intent(out) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes REAL(ReKi), DIMENSION(:), ALLOCATABLE :: hStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i,j,k ! Loop variables + INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node REAL(ReKi) :: hInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes nStructNodes = SIZE(structPositions,2) - ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat2) + ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat) + IF (ErrStat /= 0) then + ErrStat=ErrID_Fatal + ErrMsg = "error allocating hStructNodes" + return + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF ! Store the distance of the structural model nodes from the root into an array hStructNodes(1) = 0.0 ! First node @@ -1103,9 +1108,10 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(p_OpFM, ErrStat, ErrMsg) REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive force nodes INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - + ErrStat = ErrID_None + ErrMsg = "" + ! Line2 to Line2 mapping expects the destination mesh to be smaller than the source mesh for deformation mapping and larger than the source mesh for load mapping. This forces me to create nodes at the very ends of the blade. !Do the blade first @@ -1142,14 +1148,15 @@ SUBROUTINE OpFM_InterpolateForceNodesChord(InitOut_AD, p_OpFM, u_OpFM, ErrStat, CHARACTER(ErrMsgLen) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None !Local variables - INTEGER(IntKI) :: i,j,k,node ! Loop variables + INTEGER(IntKI) :: i,k,node ! Loop variables INTEGER(IntKI) :: nNodesBladeProps ! Number of nodes in the blade properties for a given blade INTEGER(IntKI) :: nNodesTowerProps ! Number of nodes in the tower properties INTEGER(IntKI) :: jLower ! Index of the blade properties node just smaller than the force node - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + ErrStat = ErrID_None + ErrMsg = "" + ! Set the chord for the hub node to be zero. Ideally, I'd like this to be the hub radius. Will figure this out later. Node = 1 u_OpFM%forceNodesChord(Node) = 0.0_ReKi diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 9d7db19f68..d613cd232a 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -378,14 +378,14 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ASSOCIATED(InData%StructBldRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -396,8 +396,10 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructBldRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StructBldRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StructBldRNodes))-1 ) = PACK(InData%StructBldRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StructBldRNodes) + DO i1 = LBOUND(InData%StructBldRNodes,1), UBOUND(InData%StructBldRNodes,1) + ReKiBuf(Re_Xferred) = InData%StructBldRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%StructTwrHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -409,15 +411,17 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructTwrHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StructTwrHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StructTwrHNodes))-1 ) = PACK(InData%StructTwrHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StructTwrHNodes) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StructTwrHNodes,1), UBOUND(InData%StructTwrHNodes,1) + ReKiBuf(Re_Xferred) = InData%StructTwrHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 END SUBROUTINE OpFM_PackInitInput SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -433,12 +437,6 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -453,17 +451,17 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%NumActForcePtsBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - OutData%NumActForcePtsTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructBldRNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -481,15 +479,10 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StructBldRNodes)>0) OutData%StructBldRNodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StructBldRNodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%StructBldRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) + OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructTwrHNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -507,57 +500,112 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StructTwrHNodes)>0) OutData%StructTwrHNodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StructTwrHNodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%StructTwrHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) + OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight END SUBROUTINE OpFM_UnPackInitInput - SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN - NULLIFY( InitInputData%StructBldRNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN + NULLIFY( InitInputData%StructBldRNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) + END IF END IF ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN - NULLIFY( InitInputData%StructTwrHNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN + NULLIFY( InitInputData%StructTwrHNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) + END IF END IF InitInputData%BladeLength = InitInputData%C_obj%BladeLength InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_C2Fary_CopyInitInput + SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC + InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade + InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower + + ! -- StructBldRNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN + InitInputData%c_obj%StructBldRNodes_Len = 0 + InitInputData%c_obj%StructBldRNodes = C_NULL_PTR + ELSE + InitInputData%c_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) + IF (InitInputData%c_obj%StructBldRNodes_Len > 0) & + InitInputData%c_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) + END IF + END IF + + ! -- StructTwrHNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN + InitInputData%c_obj%StructTwrHNodes_Len = 0 + InitInputData%c_obj%StructTwrHNodes = C_NULL_PTR + ELSE + InitInputData%c_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) + IF (InitInputData%c_obj%StructTwrHNodes_Len > 0) & + InitInputData%c_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) + END IF + END IF + InitInputData%C_obj%BladeLength = InitInputData%BladeLength + InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight + InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight + END SUBROUTINE OpFM_F2C_CopyInitInput + SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(OpFM_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -722,12 +770,12 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -739,12 +787,12 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -789,12 +837,6 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -822,19 +864,12 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -849,19 +884,12 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -905,15 +933,40 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE OpFM_UnPackInitOutput - SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF END SUBROUTINE OpFM_C2Fary_CopyInitOutput + SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + END SUBROUTINE OpFM_F2C_CopyInitOutput + SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(OpFM_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1710,12 +1763,6 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2180,15 +2227,40 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END IF END SUBROUTINE OpFM_UnPackMisc - SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF END SUBROUTINE OpFM_C2Fary_CopyMisc + SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + END SUBROUTINE OpFM_F2C_CopyMisc + SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_ParameterType), INTENT(IN) :: SrcParamData TYPE(OpFM_ParameterType), INTENT(INOUT) :: DstParamData @@ -2363,20 +2435,20 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMappings - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForce - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForceBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForceTower - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMappings + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesVel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForce + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForceBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForceTower + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ASSOCIATED(InData%forceBldRnodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2387,8 +2459,10 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceBldRnodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceBldRnodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceBldRnodes))-1 ) = PACK(InData%forceBldRnodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceBldRnodes) + DO i1 = LBOUND(InData%forceBldRnodes,1), UBOUND(InData%forceBldRnodes,1) + ReKiBuf(Re_Xferred) = InData%forceBldRnodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%forceTwrHnodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2400,15 +2474,17 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceTwrHnodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceTwrHnodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceTwrHnodes))-1 ) = PACK(InData%forceTwrHnodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceTwrHnodes) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%forceTwrHnodes,1), UBOUND(InData%forceTwrHnodes,1) + ReKiBuf(Re_Xferred) = InData%forceTwrHnodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 END SUBROUTINE OpFM_PackParam SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2424,12 +2500,6 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2444,26 +2514,26 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%AirDens = OutData%AirDens - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumBl = OutData%NumBl - OutData%NMappings = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMappings = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NMappings = OutData%NMappings - OutData%NnodesVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesVel = OutData%NnodesVel - OutData%NnodesForce = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForce = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForce = OutData%NnodesForce - OutData%NnodesForceBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForceBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - OutData%NnodesForceTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForceTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceBldRnodes not allocated Int_Xferred = Int_Xferred + 1 @@ -2481,15 +2551,10 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceBldRnodes)>0) OutData%forceBldRnodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceBldRnodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceBldRnodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) + OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceTwrHnodes not allocated Int_Xferred = Int_Xferred + 1 @@ -2507,34 +2572,37 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceTwrHnodes)>0) OutData%forceTwrHnodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceTwrHnodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceTwrHnodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) + OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight END SUBROUTINE OpFM_UnPackParam - SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ParamData%AirDens = ParamData%C_obj%AirDens ParamData%NumBl = ParamData%C_obj%NumBl ParamData%NMappings = ParamData%C_obj%NMappings @@ -2544,23 +2612,78 @@ SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower ! -- forceBldRnodes Param Data fields - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN - NULLIFY( ParamData%forceBldRnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN + NULLIFY( ParamData%forceBldRnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) + END IF END IF ! -- forceTwrHnodes Param Data fields - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN - NULLIFY( ParamData%forceTwrHnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN + NULLIFY( ParamData%forceTwrHnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) + END IF END IF ParamData%BladeLength = ParamData%C_obj%BladeLength ParamData%TowerHeight = ParamData%C_obj%TowerHeight ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_C2Fary_CopyParam + SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%AirDens = ParamData%AirDens + ParamData%C_obj%NumBl = ParamData%NumBl + ParamData%C_obj%NMappings = ParamData%NMappings + ParamData%C_obj%NnodesVel = ParamData%NnodesVel + ParamData%C_obj%NnodesForce = ParamData%NnodesForce + ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade + ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower + + ! -- forceBldRnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN + ParamData%c_obj%forceBldRnodes_Len = 0 + ParamData%c_obj%forceBldRnodes = C_NULL_PTR + ELSE + ParamData%c_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) + IF (ParamData%c_obj%forceBldRnodes_Len > 0) & + ParamData%c_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) + END IF + END IF + + ! -- forceTwrHnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN + ParamData%c_obj%forceTwrHnodes_Len = 0 + ParamData%c_obj%forceTwrHnodes = C_NULL_PTR + ELSE + ParamData%c_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) + IF (ParamData%c_obj%forceTwrHnodes_Len > 0) & + ParamData%c_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) + END IF + END IF + ParamData%C_obj%BladeLength = ParamData%BladeLength + ParamData%C_obj%TowerHeight = ParamData%TowerHeight + ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight + END SUBROUTINE OpFM_F2C_CopyParam + SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_InputType), INTENT(IN) :: SrcInputData TYPE(OpFM_InputType), INTENT(INOUT) :: DstInputData @@ -3131,8 +3254,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pxVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pxVel))-1 ) = PACK(InData%pxVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pxVel) + DO i1 = LBOUND(InData%pxVel,1), UBOUND(InData%pxVel,1) + ReKiBuf(Re_Xferred) = InData%pxVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pyVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3144,8 +3269,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pyVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pyVel))-1 ) = PACK(InData%pyVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pyVel) + DO i1 = LBOUND(InData%pyVel,1), UBOUND(InData%pyVel,1) + ReKiBuf(Re_Xferred) = InData%pyVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pzVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3157,8 +3284,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pzVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pzVel))-1 ) = PACK(InData%pzVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pzVel) + DO i1 = LBOUND(InData%pzVel,1), UBOUND(InData%pzVel,1) + ReKiBuf(Re_Xferred) = InData%pzVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pxForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3170,8 +3299,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pxForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pxForce))-1 ) = PACK(InData%pxForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pxForce) + DO i1 = LBOUND(InData%pxForce,1), UBOUND(InData%pxForce,1) + ReKiBuf(Re_Xferred) = InData%pxForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pyForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3183,8 +3314,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pyForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pyForce))-1 ) = PACK(InData%pyForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pyForce) + DO i1 = LBOUND(InData%pyForce,1), UBOUND(InData%pyForce,1) + ReKiBuf(Re_Xferred) = InData%pyForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pzForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3196,8 +3329,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pzForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pzForce))-1 ) = PACK(InData%pzForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pzForce) + DO i1 = LBOUND(InData%pzForce,1), UBOUND(InData%pzForce,1) + ReKiBuf(Re_Xferred) = InData%pzForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%xdotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3209,8 +3344,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xdotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xdotForce))-1 ) = PACK(InData%xdotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xdotForce) + DO i1 = LBOUND(InData%xdotForce,1), UBOUND(InData%xdotForce,1) + ReKiBuf(Re_Xferred) = InData%xdotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%ydotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3222,8 +3359,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ydotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ydotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ydotForce))-1 ) = PACK(InData%ydotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ydotForce) + DO i1 = LBOUND(InData%ydotForce,1), UBOUND(InData%ydotForce,1) + ReKiBuf(Re_Xferred) = InData%ydotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%zdotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3235,8 +3374,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zdotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zdotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zdotForce))-1 ) = PACK(InData%zdotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zdotForce) + DO i1 = LBOUND(InData%zdotForce,1), UBOUND(InData%zdotForce,1) + ReKiBuf(Re_Xferred) = InData%zdotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3248,8 +3389,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pOrientation,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pOrientation)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pOrientation))-1 ) = PACK(InData%pOrientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pOrientation) + DO i1 = LBOUND(InData%pOrientation,1), UBOUND(InData%pOrientation,1) + ReKiBuf(Re_Xferred) = InData%pOrientation(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3261,8 +3404,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fx))-1 ) = PACK(InData%fx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fx) + DO i1 = LBOUND(InData%fx,1), UBOUND(InData%fx,1) + ReKiBuf(Re_Xferred) = InData%fx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3274,8 +3419,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fy,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fy))-1 ) = PACK(InData%fy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fy) + DO i1 = LBOUND(InData%fy,1), UBOUND(InData%fy,1) + ReKiBuf(Re_Xferred) = InData%fy(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3287,8 +3434,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fz)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fz))-1 ) = PACK(InData%fz,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fz) + DO i1 = LBOUND(InData%fz,1), UBOUND(InData%fz,1) + ReKiBuf(Re_Xferred) = InData%fz(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momentx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3300,8 +3449,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momentx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momentx))-1 ) = PACK(InData%momentx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momentx) + DO i1 = LBOUND(InData%momentx,1), UBOUND(InData%momentx,1) + ReKiBuf(Re_Xferred) = InData%momentx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momenty) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3313,8 +3464,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momenty,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momenty)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momenty))-1 ) = PACK(InData%momenty,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momenty) + DO i1 = LBOUND(InData%momenty,1), UBOUND(InData%momenty,1) + ReKiBuf(Re_Xferred) = InData%momenty(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momentz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3326,8 +3479,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momentz)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momentz))-1 ) = PACK(InData%momentz,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momentz) + DO i1 = LBOUND(InData%momentz,1), UBOUND(InData%momentz,1) + ReKiBuf(Re_Xferred) = InData%momentz(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%forceNodesChord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3339,8 +3494,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceNodesChord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceNodesChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceNodesChord))-1 ) = PACK(InData%forceNodesChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceNodesChord) + DO i1 = LBOUND(InData%forceNodesChord,1), UBOUND(InData%forceNodesChord,1) + ReKiBuf(Re_Xferred) = InData%forceNodesChord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%SuperController) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3352,8 +3509,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_PackInput @@ -3370,12 +3529,6 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3406,15 +3559,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pxVel)>0) OutData%pxVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pxVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pxVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) + OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyVel not allocated Int_Xferred = Int_Xferred + 1 @@ -3432,15 +3580,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pyVel)>0) OutData%pyVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pyVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pyVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) + OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzVel not allocated Int_Xferred = Int_Xferred + 1 @@ -3458,15 +3601,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pzVel)>0) OutData%pzVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pzVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pzVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) + OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3484,15 +3622,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pxForce)>0) OutData%pxForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pxForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pxForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) + OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3510,15 +3643,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pyForce)>0) OutData%pyForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pyForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pyForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) + OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3536,15 +3664,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pzForce)>0) OutData%pzForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pzForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pzForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) + OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3562,15 +3685,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xdotForce)>0) OutData%xdotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xdotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%xdotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) + OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ydotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3588,15 +3706,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ydotForce)>0) OutData%ydotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ydotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%ydotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) + OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zdotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3614,15 +3727,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zdotForce)>0) OutData%zdotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zdotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%zdotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) + OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -3640,15 +3748,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pOrientation)>0) OutData%pOrientation = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pOrientation))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pOrientation) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) + OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx not allocated Int_Xferred = Int_Xferred + 1 @@ -3666,15 +3769,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fx)>0) OutData%fx = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fx))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) + OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fy not allocated Int_Xferred = Int_Xferred + 1 @@ -3692,15 +3790,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fy)>0) OutData%fy = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fy))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) + OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fz not allocated Int_Xferred = Int_Xferred + 1 @@ -3718,15 +3811,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fz)>0) OutData%fz = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fz))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) + OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentx not allocated Int_Xferred = Int_Xferred + 1 @@ -3744,15 +3832,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momentx)>0) OutData%momentx = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momentx))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momentx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) + OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momenty not allocated Int_Xferred = Int_Xferred + 1 @@ -3770,15 +3853,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momenty)>0) OutData%momenty = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momenty))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momenty) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) + OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentz not allocated Int_Xferred = Int_Xferred + 1 @@ -3796,15 +3874,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momentz)>0) OutData%momentz = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momentz))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momentz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) + OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceNodesChord not allocated Int_Xferred = Int_Xferred + 1 @@ -3822,15 +3895,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceNodesChord)>0) OutData%forceNodesChord = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceNodesChord))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceNodesChord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) + OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SuperController not allocated Int_Xferred = Int_Xferred + 1 @@ -3848,153 +3916,425 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%SuperController_Len = SIZE(OutData%SuperController) IF (OutData%c_obj%SuperController_Len > 0) & OutData%c_obj%SuperController = C_LOC( OutData%SuperController(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_UnPackInput - SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- pxVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN - NULLIFY( InputData%pxVel ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN + NULLIFY( InputData%pxVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) + END IF END IF ! -- pyVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN - NULLIFY( InputData%pyVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN + NULLIFY( InputData%pyVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) + END IF END IF ! -- pzVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN - NULLIFY( InputData%pzVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN + NULLIFY( InputData%pzVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) + END IF END IF ! -- pxForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN - NULLIFY( InputData%pxForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN + NULLIFY( InputData%pxForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) + END IF END IF ! -- pyForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN - NULLIFY( InputData%pyForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN + NULLIFY( InputData%pyForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) + END IF END IF ! -- pzForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN - NULLIFY( InputData%pzForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN + NULLIFY( InputData%pzForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) + END IF END IF ! -- xdotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN - NULLIFY( InputData%xdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN + NULLIFY( InputData%xdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) + END IF END IF ! -- ydotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN - NULLIFY( InputData%ydotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN + NULLIFY( InputData%ydotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) + END IF END IF ! -- zdotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN - NULLIFY( InputData%zdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN + NULLIFY( InputData%zdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) + END IF END IF ! -- pOrientation Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN - NULLIFY( InputData%pOrientation ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN + NULLIFY( InputData%pOrientation ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) + END IF END IF ! -- fx Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN - NULLIFY( InputData%fx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN + NULLIFY( InputData%fx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) + END IF END IF ! -- fy Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN - NULLIFY( InputData%fy ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN + NULLIFY( InputData%fy ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) + END IF END IF ! -- fz Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN - NULLIFY( InputData%fz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN + NULLIFY( InputData%fz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) + END IF END IF ! -- momentx Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN - NULLIFY( InputData%momentx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN + NULLIFY( InputData%momentx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) + END IF END IF ! -- momenty Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN - NULLIFY( InputData%momenty ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN + NULLIFY( InputData%momenty ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) + END IF END IF ! -- momentz Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN - NULLIFY( InputData%momentz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN + NULLIFY( InputData%momentz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) + END IF END IF ! -- forceNodesChord Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN - NULLIFY( InputData%forceNodesChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN + NULLIFY( InputData%forceNodesChord ) + ELSE + CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) + END IF END IF ! -- SuperController Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%SuperController ) ) THEN - NULLIFY( InputData%SuperController ) - ELSE - CALL C_F_POINTER(InputData%C_obj%SuperController, InputData%SuperController, (/InputData%C_obj%SuperController_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%SuperController ) ) THEN + NULLIFY( InputData%SuperController ) + ELSE + CALL C_F_POINTER(InputData%C_obj%SuperController, InputData%SuperController, (/InputData%C_obj%SuperController_Len/)) + END IF END IF END SUBROUTINE OpFM_C2Fary_CopyInput + SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pxVel)) THEN + InputData%c_obj%pxVel_Len = 0 + InputData%c_obj%pxVel = C_NULL_PTR + ELSE + InputData%c_obj%pxVel_Len = SIZE(InputData%pxVel) + IF (InputData%c_obj%pxVel_Len > 0) & + InputData%c_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) + END IF + END IF + + ! -- pyVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pyVel)) THEN + InputData%c_obj%pyVel_Len = 0 + InputData%c_obj%pyVel = C_NULL_PTR + ELSE + InputData%c_obj%pyVel_Len = SIZE(InputData%pyVel) + IF (InputData%c_obj%pyVel_Len > 0) & + InputData%c_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) + END IF + END IF + + ! -- pzVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pzVel)) THEN + InputData%c_obj%pzVel_Len = 0 + InputData%c_obj%pzVel = C_NULL_PTR + ELSE + InputData%c_obj%pzVel_Len = SIZE(InputData%pzVel) + IF (InputData%c_obj%pzVel_Len > 0) & + InputData%c_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) + END IF + END IF + + ! -- pxForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pxForce)) THEN + InputData%c_obj%pxForce_Len = 0 + InputData%c_obj%pxForce = C_NULL_PTR + ELSE + InputData%c_obj%pxForce_Len = SIZE(InputData%pxForce) + IF (InputData%c_obj%pxForce_Len > 0) & + InputData%c_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) + END IF + END IF + + ! -- pyForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pyForce)) THEN + InputData%c_obj%pyForce_Len = 0 + InputData%c_obj%pyForce = C_NULL_PTR + ELSE + InputData%c_obj%pyForce_Len = SIZE(InputData%pyForce) + IF (InputData%c_obj%pyForce_Len > 0) & + InputData%c_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) + END IF + END IF + + ! -- pzForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pzForce)) THEN + InputData%c_obj%pzForce_Len = 0 + InputData%c_obj%pzForce = C_NULL_PTR + ELSE + InputData%c_obj%pzForce_Len = SIZE(InputData%pzForce) + IF (InputData%c_obj%pzForce_Len > 0) & + InputData%c_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) + END IF + END IF + + ! -- xdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%xdotForce)) THEN + InputData%c_obj%xdotForce_Len = 0 + InputData%c_obj%xdotForce = C_NULL_PTR + ELSE + InputData%c_obj%xdotForce_Len = SIZE(InputData%xdotForce) + IF (InputData%c_obj%xdotForce_Len > 0) & + InputData%c_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) + END IF + END IF + + ! -- ydotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%ydotForce)) THEN + InputData%c_obj%ydotForce_Len = 0 + InputData%c_obj%ydotForce = C_NULL_PTR + ELSE + InputData%c_obj%ydotForce_Len = SIZE(InputData%ydotForce) + IF (InputData%c_obj%ydotForce_Len > 0) & + InputData%c_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) + END IF + END IF + + ! -- zdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%zdotForce)) THEN + InputData%c_obj%zdotForce_Len = 0 + InputData%c_obj%zdotForce = C_NULL_PTR + ELSE + InputData%c_obj%zdotForce_Len = SIZE(InputData%zdotForce) + IF (InputData%c_obj%zdotForce_Len > 0) & + InputData%c_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) + END IF + END IF + + ! -- pOrientation Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN + InputData%c_obj%pOrientation_Len = 0 + InputData%c_obj%pOrientation = C_NULL_PTR + ELSE + InputData%c_obj%pOrientation_Len = SIZE(InputData%pOrientation) + IF (InputData%c_obj%pOrientation_Len > 0) & + InputData%c_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) + END IF + END IF + + ! -- fx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fx)) THEN + InputData%c_obj%fx_Len = 0 + InputData%c_obj%fx = C_NULL_PTR + ELSE + InputData%c_obj%fx_Len = SIZE(InputData%fx) + IF (InputData%c_obj%fx_Len > 0) & + InputData%c_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) + END IF + END IF + + ! -- fy Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fy)) THEN + InputData%c_obj%fy_Len = 0 + InputData%c_obj%fy = C_NULL_PTR + ELSE + InputData%c_obj%fy_Len = SIZE(InputData%fy) + IF (InputData%c_obj%fy_Len > 0) & + InputData%c_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) + END IF + END IF + + ! -- fz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fz)) THEN + InputData%c_obj%fz_Len = 0 + InputData%c_obj%fz = C_NULL_PTR + ELSE + InputData%c_obj%fz_Len = SIZE(InputData%fz) + IF (InputData%c_obj%fz_Len > 0) & + InputData%c_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) + END IF + END IF + + ! -- momentx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momentx)) THEN + InputData%c_obj%momentx_Len = 0 + InputData%c_obj%momentx = C_NULL_PTR + ELSE + InputData%c_obj%momentx_Len = SIZE(InputData%momentx) + IF (InputData%c_obj%momentx_Len > 0) & + InputData%c_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) + END IF + END IF + + ! -- momenty Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momenty)) THEN + InputData%c_obj%momenty_Len = 0 + InputData%c_obj%momenty = C_NULL_PTR + ELSE + InputData%c_obj%momenty_Len = SIZE(InputData%momenty) + IF (InputData%c_obj%momenty_Len > 0) & + InputData%c_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) + END IF + END IF + + ! -- momentz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momentz)) THEN + InputData%c_obj%momentz_Len = 0 + InputData%c_obj%momentz = C_NULL_PTR + ELSE + InputData%c_obj%momentz_Len = SIZE(InputData%momentz) + IF (InputData%c_obj%momentz_Len > 0) & + InputData%c_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) + END IF + END IF + + ! -- forceNodesChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%forceNodesChord)) THEN + InputData%c_obj%forceNodesChord_Len = 0 + InputData%c_obj%forceNodesChord = C_NULL_PTR + ELSE + InputData%c_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) + IF (InputData%c_obj%forceNodesChord_Len > 0) & + InputData%c_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) + END IF + END IF + + ! -- SuperController Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%SuperController)) THEN + InputData%c_obj%SuperController_Len = 0 + InputData%c_obj%SuperController = C_NULL_PTR + ELSE + InputData%c_obj%SuperController_Len = SIZE(InputData%SuperController) + IF (InputData%c_obj%SuperController_Len > 0) & + InputData%c_obj%SuperController = C_LOC( InputData%SuperController( LBOUND(InputData%SuperController,1) ) ) + END IF + END IF + END SUBROUTINE OpFM_F2C_CopyInput + SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_OutputType), INTENT(IN) :: SrcOutputData TYPE(OpFM_OutputType), INTENT(INOUT) :: DstOutputData @@ -4081,7 +4421,6 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput - DstOutputData%C_obj%WriteOutput = SrcOutputData%C_obj%WriteOutput ENDIF END SUBROUTINE OpFM_CopyOutput @@ -4222,8 +4561,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%u))-1 ) = PACK(InData%u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%u) + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + ReKiBuf(Re_Xferred) = InData%u(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%v) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4235,8 +4576,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%v,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%v)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%v))-1 ) = PACK(InData%v,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%v) + DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) + ReKiBuf(Re_Xferred) = InData%v(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%w) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4248,8 +4591,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%w,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%w)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%w))-1 ) = PACK(InData%w,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%w) + DO i1 = LBOUND(InData%w,1), UBOUND(InData%w,1) + ReKiBuf(Re_Xferred) = InData%w(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%SuperController) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4261,8 +4606,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4274,8 +4621,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_PackOutput @@ -4292,12 +4641,6 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4328,15 +4671,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%u)>0) OutData%u = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%u))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! v not allocated Int_Xferred = Int_Xferred + 1 @@ -4354,15 +4692,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%v)>0) OutData%v = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%v))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%v) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) + OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! w not allocated Int_Xferred = Int_Xferred + 1 @@ -4380,15 +4713,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%w)>0) OutData%w = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%w))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%w) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) + OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SuperController not allocated Int_Xferred = Int_Xferred + 1 @@ -4406,15 +4734,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%SuperController_Len = SIZE(OutData%SuperController) IF (OutData%c_obj%SuperController_Len > 0) & OutData%c_obj%SuperController = C_LOC( OutData%SuperController(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4429,55 +4752,131 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_UnPackOutput - SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- u Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN - NULLIFY( OutputData%u ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN + NULLIFY( OutputData%u ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) + END IF END IF ! -- v Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN - NULLIFY( OutputData%v ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN + NULLIFY( OutputData%v ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) + END IF END IF ! -- w Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN - NULLIFY( OutputData%w ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN + NULLIFY( OutputData%w ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) + END IF END IF ! -- SuperController Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%SuperController ) ) THEN - NULLIFY( OutputData%SuperController ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%SuperController, OutputData%SuperController, (/OutputData%C_obj%SuperController_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%SuperController ) ) THEN + NULLIFY( OutputData%SuperController ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%SuperController, OutputData%SuperController, (/OutputData%C_obj%SuperController_Len/)) + END IF END IF END SUBROUTINE OpFM_C2Fary_CopyOutput + SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%u)) THEN + OutputData%c_obj%u_Len = 0 + OutputData%c_obj%u = C_NULL_PTR + ELSE + OutputData%c_obj%u_Len = SIZE(OutputData%u) + IF (OutputData%c_obj%u_Len > 0) & + OutputData%c_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) + END IF + END IF + + ! -- v Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%v)) THEN + OutputData%c_obj%v_Len = 0 + OutputData%c_obj%v = C_NULL_PTR + ELSE + OutputData%c_obj%v_Len = SIZE(OutputData%v) + IF (OutputData%c_obj%v_Len > 0) & + OutputData%c_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) + END IF + END IF + + ! -- w Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%w)) THEN + OutputData%c_obj%w_Len = 0 + OutputData%c_obj%w = C_NULL_PTR + ELSE + OutputData%c_obj%w_Len = SIZE(OutputData%w) + IF (OutputData%c_obj%w_Len > 0) & + OutputData%c_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) + END IF + END IF + + ! -- SuperController Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%SuperController)) THEN + OutputData%c_obj%SuperController_Len = 0 + OutputData%c_obj%SuperController = C_NULL_PTR + ELSE + OutputData%c_obj%SuperController_Len = SIZE(OutputData%SuperController) + IF (OutputData%c_obj%SuperController_Len > 0) & + OutputData%c_obj%SuperController = C_LOC( OutputData%SuperController( LBOUND(OutputData%SuperController,1) ) ) + END IF + END IF + END SUBROUTINE OpFM_F2C_CopyOutput + SUBROUTINE OpFM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -4553,12 +4952,12 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4571,149 +4970,115 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - ALLOCATE(b1(SIZE(u_out%pxVel,1))) - ALLOCATE(c1(SIZE(u_out%pxVel,1))) - b1 = -(u1%pxVel - u2%pxVel)/t(2) - u_out%pxVel = u1%pxVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) + b = -(u1%pxVel(i1) - u2%pxVel(i1)) + u_out%pxVel(i1) = u1%pxVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - ALLOCATE(b1(SIZE(u_out%pyVel,1))) - ALLOCATE(c1(SIZE(u_out%pyVel,1))) - b1 = -(u1%pyVel - u2%pyVel)/t(2) - u_out%pyVel = u1%pyVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) + b = -(u1%pyVel(i1) - u2%pyVel(i1)) + u_out%pyVel(i1) = u1%pyVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - ALLOCATE(b1(SIZE(u_out%pzVel,1))) - ALLOCATE(c1(SIZE(u_out%pzVel,1))) - b1 = -(u1%pzVel - u2%pzVel)/t(2) - u_out%pzVel = u1%pzVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) + b = -(u1%pzVel(i1) - u2%pzVel(i1)) + u_out%pzVel(i1) = u1%pzVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - ALLOCATE(b1(SIZE(u_out%pxForce,1))) - ALLOCATE(c1(SIZE(u_out%pxForce,1))) - b1 = -(u1%pxForce - u2%pxForce)/t(2) - u_out%pxForce = u1%pxForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) + b = -(u1%pxForce(i1) - u2%pxForce(i1)) + u_out%pxForce(i1) = u1%pxForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - ALLOCATE(b1(SIZE(u_out%pyForce,1))) - ALLOCATE(c1(SIZE(u_out%pyForce,1))) - b1 = -(u1%pyForce - u2%pyForce)/t(2) - u_out%pyForce = u1%pyForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) + b = -(u1%pyForce(i1) - u2%pyForce(i1)) + u_out%pyForce(i1) = u1%pyForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - ALLOCATE(b1(SIZE(u_out%pzForce,1))) - ALLOCATE(c1(SIZE(u_out%pzForce,1))) - b1 = -(u1%pzForce - u2%pzForce)/t(2) - u_out%pzForce = u1%pzForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) + b = -(u1%pzForce(i1) - u2%pzForce(i1)) + u_out%pzForce(i1) = u1%pzForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%xdotForce,1))) - ALLOCATE(c1(SIZE(u_out%xdotForce,1))) - b1 = -(u1%xdotForce - u2%xdotForce)/t(2) - u_out%xdotForce = u1%xdotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) + b = -(u1%xdotForce(i1) - u2%xdotForce(i1)) + u_out%xdotForce(i1) = u1%xdotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - ALLOCATE(b1(SIZE(u_out%ydotForce,1))) - ALLOCATE(c1(SIZE(u_out%ydotForce,1))) - b1 = -(u1%ydotForce - u2%ydotForce)/t(2) - u_out%ydotForce = u1%ydotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) + b = -(u1%ydotForce(i1) - u2%ydotForce(i1)) + u_out%ydotForce(i1) = u1%ydotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%zdotForce,1))) - ALLOCATE(c1(SIZE(u_out%zdotForce,1))) - b1 = -(u1%zdotForce - u2%zdotForce)/t(2) - u_out%zdotForce = u1%zdotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) + b = -(u1%zdotForce(i1) - u2%zdotForce(i1)) + u_out%zdotForce(i1) = u1%zdotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - ALLOCATE(b1(SIZE(u_out%pOrientation,1))) - ALLOCATE(c1(SIZE(u_out%pOrientation,1))) - b1 = -(u1%pOrientation - u2%pOrientation)/t(2) - u_out%pOrientation = u1%pOrientation + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) + b = -(u1%pOrientation(i1) - u2%pOrientation(i1)) + u_out%pOrientation(i1) = u1%pOrientation(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - ALLOCATE(b1(SIZE(u_out%fx,1))) - ALLOCATE(c1(SIZE(u_out%fx,1))) - b1 = -(u1%fx - u2%fx)/t(2) - u_out%fx = u1%fx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) + b = -(u1%fx(i1) - u2%fx(i1)) + u_out%fx(i1) = u1%fx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - ALLOCATE(b1(SIZE(u_out%fy,1))) - ALLOCATE(c1(SIZE(u_out%fy,1))) - b1 = -(u1%fy - u2%fy)/t(2) - u_out%fy = u1%fy + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) + b = -(u1%fy(i1) - u2%fy(i1)) + u_out%fy(i1) = u1%fy(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - ALLOCATE(b1(SIZE(u_out%fz,1))) - ALLOCATE(c1(SIZE(u_out%fz,1))) - b1 = -(u1%fz - u2%fz)/t(2) - u_out%fz = u1%fz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) + b = -(u1%fz(i1) - u2%fz(i1)) + u_out%fz(i1) = u1%fz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - ALLOCATE(b1(SIZE(u_out%momentx,1))) - ALLOCATE(c1(SIZE(u_out%momentx,1))) - b1 = -(u1%momentx - u2%momentx)/t(2) - u_out%momentx = u1%momentx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) + b = -(u1%momentx(i1) - u2%momentx(i1)) + u_out%momentx(i1) = u1%momentx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - ALLOCATE(b1(SIZE(u_out%momenty,1))) - ALLOCATE(c1(SIZE(u_out%momenty,1))) - b1 = -(u1%momenty - u2%momenty)/t(2) - u_out%momenty = u1%momenty + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) + b = -(u1%momenty(i1) - u2%momenty(i1)) + u_out%momenty(i1) = u1%momenty(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - ALLOCATE(b1(SIZE(u_out%momentz,1))) - ALLOCATE(c1(SIZE(u_out%momentz,1))) - b1 = -(u1%momentz - u2%momentz)/t(2) - u_out%momentz = u1%momentz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) + b = -(u1%momentz(i1) - u2%momentz(i1)) + u_out%momentz(i1) = u1%momentz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - ALLOCATE(b1(SIZE(u_out%forceNodesChord,1))) - ALLOCATE(c1(SIZE(u_out%forceNodesChord,1))) - b1 = -(u1%forceNodesChord - u2%forceNodesChord)/t(2) - u_out%forceNodesChord = u1%forceNodesChord + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) + b = -(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%SuperController) .AND. ASSOCIATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = -(u1%SuperController - u2%SuperController)/t(2) - u_out%SuperController = u1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = -(u1%SuperController(i1) - u2%SuperController(i1)) + u_out%SuperController(i1) = u1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE OpFM_Input_ExtrapInterp1 @@ -4744,13 +5109,14 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4769,167 +5135,133 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - ALLOCATE(b1(SIZE(u_out%pxVel,1))) - ALLOCATE(c1(SIZE(u_out%pxVel,1))) - b1 = (t(3)**2*(u1%pxVel - u2%pxVel) + t(2)**2*(-u1%pxVel + u3%pxVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pxVel + t(3)*u2%pxVel - t(2)*u3%pxVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pxVel = u1%pxVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) + b = (t(3)**2*(u1%pxVel(i1) - u2%pxVel(i1)) + t(2)**2*(-u1%pxVel(i1) + u3%pxVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pxVel(i1) + t(3)*u2%pxVel(i1) - t(2)*u3%pxVel(i1) ) * scaleFactor + u_out%pxVel(i1) = u1%pxVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - ALLOCATE(b1(SIZE(u_out%pyVel,1))) - ALLOCATE(c1(SIZE(u_out%pyVel,1))) - b1 = (t(3)**2*(u1%pyVel - u2%pyVel) + t(2)**2*(-u1%pyVel + u3%pyVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pyVel + t(3)*u2%pyVel - t(2)*u3%pyVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pyVel = u1%pyVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) + b = (t(3)**2*(u1%pyVel(i1) - u2%pyVel(i1)) + t(2)**2*(-u1%pyVel(i1) + u3%pyVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pyVel(i1) + t(3)*u2%pyVel(i1) - t(2)*u3%pyVel(i1) ) * scaleFactor + u_out%pyVel(i1) = u1%pyVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - ALLOCATE(b1(SIZE(u_out%pzVel,1))) - ALLOCATE(c1(SIZE(u_out%pzVel,1))) - b1 = (t(3)**2*(u1%pzVel - u2%pzVel) + t(2)**2*(-u1%pzVel + u3%pzVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pzVel + t(3)*u2%pzVel - t(2)*u3%pzVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pzVel = u1%pzVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) + b = (t(3)**2*(u1%pzVel(i1) - u2%pzVel(i1)) + t(2)**2*(-u1%pzVel(i1) + u3%pzVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pzVel(i1) + t(3)*u2%pzVel(i1) - t(2)*u3%pzVel(i1) ) * scaleFactor + u_out%pzVel(i1) = u1%pzVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - ALLOCATE(b1(SIZE(u_out%pxForce,1))) - ALLOCATE(c1(SIZE(u_out%pxForce,1))) - b1 = (t(3)**2*(u1%pxForce - u2%pxForce) + t(2)**2*(-u1%pxForce + u3%pxForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pxForce + t(3)*u2%pxForce - t(2)*u3%pxForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pxForce = u1%pxForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) + b = (t(3)**2*(u1%pxForce(i1) - u2%pxForce(i1)) + t(2)**2*(-u1%pxForce(i1) + u3%pxForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pxForce(i1) + t(3)*u2%pxForce(i1) - t(2)*u3%pxForce(i1) ) * scaleFactor + u_out%pxForce(i1) = u1%pxForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - ALLOCATE(b1(SIZE(u_out%pyForce,1))) - ALLOCATE(c1(SIZE(u_out%pyForce,1))) - b1 = (t(3)**2*(u1%pyForce - u2%pyForce) + t(2)**2*(-u1%pyForce + u3%pyForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pyForce + t(3)*u2%pyForce - t(2)*u3%pyForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pyForce = u1%pyForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) + b = (t(3)**2*(u1%pyForce(i1) - u2%pyForce(i1)) + t(2)**2*(-u1%pyForce(i1) + u3%pyForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pyForce(i1) + t(3)*u2%pyForce(i1) - t(2)*u3%pyForce(i1) ) * scaleFactor + u_out%pyForce(i1) = u1%pyForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - ALLOCATE(b1(SIZE(u_out%pzForce,1))) - ALLOCATE(c1(SIZE(u_out%pzForce,1))) - b1 = (t(3)**2*(u1%pzForce - u2%pzForce) + t(2)**2*(-u1%pzForce + u3%pzForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pzForce + t(3)*u2%pzForce - t(2)*u3%pzForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pzForce = u1%pzForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) + b = (t(3)**2*(u1%pzForce(i1) - u2%pzForce(i1)) + t(2)**2*(-u1%pzForce(i1) + u3%pzForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pzForce(i1) + t(3)*u2%pzForce(i1) - t(2)*u3%pzForce(i1) ) * scaleFactor + u_out%pzForce(i1) = u1%pzForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%xdotForce,1))) - ALLOCATE(c1(SIZE(u_out%xdotForce,1))) - b1 = (t(3)**2*(u1%xdotForce - u2%xdotForce) + t(2)**2*(-u1%xdotForce + u3%xdotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%xdotForce + t(3)*u2%xdotForce - t(2)*u3%xdotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%xdotForce = u1%xdotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) + b = (t(3)**2*(u1%xdotForce(i1) - u2%xdotForce(i1)) + t(2)**2*(-u1%xdotForce(i1) + u3%xdotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%xdotForce(i1) + t(3)*u2%xdotForce(i1) - t(2)*u3%xdotForce(i1) ) * scaleFactor + u_out%xdotForce(i1) = u1%xdotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - ALLOCATE(b1(SIZE(u_out%ydotForce,1))) - ALLOCATE(c1(SIZE(u_out%ydotForce,1))) - b1 = (t(3)**2*(u1%ydotForce - u2%ydotForce) + t(2)**2*(-u1%ydotForce + u3%ydotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%ydotForce + t(3)*u2%ydotForce - t(2)*u3%ydotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ydotForce = u1%ydotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) + b = (t(3)**2*(u1%ydotForce(i1) - u2%ydotForce(i1)) + t(2)**2*(-u1%ydotForce(i1) + u3%ydotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%ydotForce(i1) + t(3)*u2%ydotForce(i1) - t(2)*u3%ydotForce(i1) ) * scaleFactor + u_out%ydotForce(i1) = u1%ydotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%zdotForce,1))) - ALLOCATE(c1(SIZE(u_out%zdotForce,1))) - b1 = (t(3)**2*(u1%zdotForce - u2%zdotForce) + t(2)**2*(-u1%zdotForce + u3%zdotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%zdotForce + t(3)*u2%zdotForce - t(2)*u3%zdotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%zdotForce = u1%zdotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) + b = (t(3)**2*(u1%zdotForce(i1) - u2%zdotForce(i1)) + t(2)**2*(-u1%zdotForce(i1) + u3%zdotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%zdotForce(i1) + t(3)*u2%zdotForce(i1) - t(2)*u3%zdotForce(i1) ) * scaleFactor + u_out%zdotForce(i1) = u1%zdotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - ALLOCATE(b1(SIZE(u_out%pOrientation,1))) - ALLOCATE(c1(SIZE(u_out%pOrientation,1))) - b1 = (t(3)**2*(u1%pOrientation - u2%pOrientation) + t(2)**2*(-u1%pOrientation + u3%pOrientation))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pOrientation + t(3)*u2%pOrientation - t(2)*u3%pOrientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pOrientation = u1%pOrientation + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) + b = (t(3)**2*(u1%pOrientation(i1) - u2%pOrientation(i1)) + t(2)**2*(-u1%pOrientation(i1) + u3%pOrientation(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pOrientation(i1) + t(3)*u2%pOrientation(i1) - t(2)*u3%pOrientation(i1) ) * scaleFactor + u_out%pOrientation(i1) = u1%pOrientation(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - ALLOCATE(b1(SIZE(u_out%fx,1))) - ALLOCATE(c1(SIZE(u_out%fx,1))) - b1 = (t(3)**2*(u1%fx - u2%fx) + t(2)**2*(-u1%fx + u3%fx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fx + t(3)*u2%fx - t(2)*u3%fx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fx = u1%fx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) + b = (t(3)**2*(u1%fx(i1) - u2%fx(i1)) + t(2)**2*(-u1%fx(i1) + u3%fx(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fx(i1) + t(3)*u2%fx(i1) - t(2)*u3%fx(i1) ) * scaleFactor + u_out%fx(i1) = u1%fx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - ALLOCATE(b1(SIZE(u_out%fy,1))) - ALLOCATE(c1(SIZE(u_out%fy,1))) - b1 = (t(3)**2*(u1%fy - u2%fy) + t(2)**2*(-u1%fy + u3%fy))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fy + t(3)*u2%fy - t(2)*u3%fy ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fy = u1%fy + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) + b = (t(3)**2*(u1%fy(i1) - u2%fy(i1)) + t(2)**2*(-u1%fy(i1) + u3%fy(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fy(i1) + t(3)*u2%fy(i1) - t(2)*u3%fy(i1) ) * scaleFactor + u_out%fy(i1) = u1%fy(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - ALLOCATE(b1(SIZE(u_out%fz,1))) - ALLOCATE(c1(SIZE(u_out%fz,1))) - b1 = (t(3)**2*(u1%fz - u2%fz) + t(2)**2*(-u1%fz + u3%fz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fz + t(3)*u2%fz - t(2)*u3%fz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fz = u1%fz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) + b = (t(3)**2*(u1%fz(i1) - u2%fz(i1)) + t(2)**2*(-u1%fz(i1) + u3%fz(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fz(i1) + t(3)*u2%fz(i1) - t(2)*u3%fz(i1) ) * scaleFactor + u_out%fz(i1) = u1%fz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - ALLOCATE(b1(SIZE(u_out%momentx,1))) - ALLOCATE(c1(SIZE(u_out%momentx,1))) - b1 = (t(3)**2*(u1%momentx - u2%momentx) + t(2)**2*(-u1%momentx + u3%momentx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momentx + t(3)*u2%momentx - t(2)*u3%momentx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momentx = u1%momentx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) + b = (t(3)**2*(u1%momentx(i1) - u2%momentx(i1)) + t(2)**2*(-u1%momentx(i1) + u3%momentx(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momentx(i1) + t(3)*u2%momentx(i1) - t(2)*u3%momentx(i1) ) * scaleFactor + u_out%momentx(i1) = u1%momentx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - ALLOCATE(b1(SIZE(u_out%momenty,1))) - ALLOCATE(c1(SIZE(u_out%momenty,1))) - b1 = (t(3)**2*(u1%momenty - u2%momenty) + t(2)**2*(-u1%momenty + u3%momenty))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momenty + t(3)*u2%momenty - t(2)*u3%momenty ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momenty = u1%momenty + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) + b = (t(3)**2*(u1%momenty(i1) - u2%momenty(i1)) + t(2)**2*(-u1%momenty(i1) + u3%momenty(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momenty(i1) + t(3)*u2%momenty(i1) - t(2)*u3%momenty(i1) ) * scaleFactor + u_out%momenty(i1) = u1%momenty(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - ALLOCATE(b1(SIZE(u_out%momentz,1))) - ALLOCATE(c1(SIZE(u_out%momentz,1))) - b1 = (t(3)**2*(u1%momentz - u2%momentz) + t(2)**2*(-u1%momentz + u3%momentz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momentz + t(3)*u2%momentz - t(2)*u3%momentz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momentz = u1%momentz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) + b = (t(3)**2*(u1%momentz(i1) - u2%momentz(i1)) + t(2)**2*(-u1%momentz(i1) + u3%momentz(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momentz(i1) + t(3)*u2%momentz(i1) - t(2)*u3%momentz(i1) ) * scaleFactor + u_out%momentz(i1) = u1%momentz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - ALLOCATE(b1(SIZE(u_out%forceNodesChord,1))) - ALLOCATE(c1(SIZE(u_out%forceNodesChord,1))) - b1 = (t(3)**2*(u1%forceNodesChord - u2%forceNodesChord) + t(2)**2*(-u1%forceNodesChord + u3%forceNodesChord))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%forceNodesChord + t(3)*u2%forceNodesChord - t(2)*u3%forceNodesChord ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%forceNodesChord = u1%forceNodesChord + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) + b = (t(3)**2*(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + t(2)**2*(-u1%forceNodesChord(i1) + u3%forceNodesChord(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%forceNodesChord(i1) + t(3)*u2%forceNodesChord(i1) - t(2)*u3%forceNodesChord(i1) ) * scaleFactor + u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%SuperController) .AND. ASSOCIATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = (t(3)**2*(u1%SuperController - u2%SuperController) + t(2)**2*(-u1%SuperController + u3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SuperController + t(3)*u2%SuperController - t(2)*u3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SuperController = u1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = (t(3)**2*(u1%SuperController(i1) - u2%SuperController(i1)) + t(2)**2*(-u1%SuperController(i1) + u3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%SuperController(i1) + t(3)*u2%SuperController(i1) - t(2)*u3%SuperController(i1) ) * scaleFactor + u_out%SuperController(i1) = u1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE OpFM_Input_ExtrapInterp2 @@ -5008,12 +5340,12 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5026,45 +5358,37 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - ALLOCATE(b1(SIZE(y_out%u,1))) - ALLOCATE(c1(SIZE(y_out%u,1))) - b1 = -(y1%u - y2%u)/t(2) - y_out%u = y1%u + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) + b = -(y1%u(i1) - y2%u(i1)) + y_out%u(i1) = y1%u(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - ALLOCATE(b1(SIZE(y_out%v,1))) - ALLOCATE(c1(SIZE(y_out%v,1))) - b1 = -(y1%v - y2%v)/t(2) - y_out%v = y1%v + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) + b = -(y1%v(i1) - y2%v(i1)) + y_out%v(i1) = y1%v(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - ALLOCATE(b1(SIZE(y_out%w,1))) - ALLOCATE(c1(SIZE(y_out%w,1))) - b1 = -(y1%w - y2%w)/t(2) - y_out%w = y1%w + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) + b = -(y1%w(i1) - y2%w(i1)) + y_out%w(i1) = y1%w(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%SuperController) .AND. ASSOCIATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = -(y1%SuperController - y2%SuperController)/t(2) - y_out%SuperController = y1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = -(y1%SuperController(i1) - y2%SuperController(i1)) + y_out%SuperController(i1) = y1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE OpFM_Output_ExtrapInterp1 @@ -5095,13 +5419,14 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5120,50 +5445,42 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - ALLOCATE(b1(SIZE(y_out%u,1))) - ALLOCATE(c1(SIZE(y_out%u,1))) - b1 = (t(3)**2*(y1%u - y2%u) + t(2)**2*(-y1%u + y3%u))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%u + t(3)*y2%u - t(2)*y3%u ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%u = y1%u + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) + b = (t(3)**2*(y1%u(i1) - y2%u(i1)) + t(2)**2*(-y1%u(i1) + y3%u(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%u(i1) + t(3)*y2%u(i1) - t(2)*y3%u(i1) ) * scaleFactor + y_out%u(i1) = y1%u(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - ALLOCATE(b1(SIZE(y_out%v,1))) - ALLOCATE(c1(SIZE(y_out%v,1))) - b1 = (t(3)**2*(y1%v - y2%v) + t(2)**2*(-y1%v + y3%v))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%v + t(3)*y2%v - t(2)*y3%v ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%v = y1%v + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) + b = (t(3)**2*(y1%v(i1) - y2%v(i1)) + t(2)**2*(-y1%v(i1) + y3%v(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%v(i1) + t(3)*y2%v(i1) - t(2)*y3%v(i1) ) * scaleFactor + y_out%v(i1) = y1%v(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - ALLOCATE(b1(SIZE(y_out%w,1))) - ALLOCATE(c1(SIZE(y_out%w,1))) - b1 = (t(3)**2*(y1%w - y2%w) + t(2)**2*(-y1%w + y3%w))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%w + t(3)*y2%w - t(2)*y3%w ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%w = y1%w + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) + b = (t(3)**2*(y1%w(i1) - y2%w(i1)) + t(2)**2*(-y1%w(i1) + y3%w(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%w(i1) + t(3)*y2%w(i1) - t(2)*y3%w(i1) ) * scaleFactor + y_out%w(i1) = y1%w(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%SuperController) .AND. ASSOCIATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = (t(3)**2*(y1%SuperController - y2%SuperController) + t(2)**2*(-y1%SuperController + y3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%SuperController + t(3)*y2%SuperController - t(2)*y3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SuperController = y1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = (t(3)**2*(y1%SuperController(i1) - y2%SuperController(i1)) + t(2)**2*(-y1%SuperController(i1) + y3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%SuperController(i1) + t(3)*y2%SuperController(i1) - t(2)*y3%SuperController(i1) ) * scaleFactor + y_out%SuperController(i1) = y1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE OpFM_Output_ExtrapInterp2 diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 8efb21566c..51a40873d8 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -204,16 +204,16 @@ SUBROUTINE Orca_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMax - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%TMax + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackInitInput SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -229,12 +229,6 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -250,16 +244,16 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackInitInput SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -452,12 +446,12 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -469,12 +463,12 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE Orca_PackInitOutput @@ -491,12 +485,6 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -564,19 +552,12 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -591,19 +572,12 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE Orca_UnPackInitOutput @@ -706,26 +680,26 @@ SUBROUTINE Orca_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InitProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_CalcProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_EndProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_InitProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_CalcProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_EndProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Orca_PackInputFile SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -741,12 +715,6 @@ SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInputFile' @@ -760,26 +728,26 @@ SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InitProcName) - OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_CalcProcName) - OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_EndProcName) - OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_InitProcName) + OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_CalcProcName) + OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_EndProcName) + OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Orca_UnPackInputFile SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -873,8 +841,8 @@ SUBROUTINE Orca_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackOtherState SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -890,12 +858,6 @@ SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOtherState' @@ -909,8 +871,8 @@ SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackOtherState SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1032,12 +994,20 @@ SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAM))-1 ) = PACK(InData%PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) + DO i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) + DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) + ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1048,11 +1018,13 @@ SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeStep - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeStep + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Orca_PackMisc SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1068,12 +1040,6 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1093,37 +1059,24 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i1_u = UBOUND(OutData%PtfmAM,1) i2_l = LBOUND(OutData%PtfmAM,2) i2_u = UBOUND(OutData%PtfmAM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) + DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) + OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%PtfmFt,1) i1_u = UBOUND(OutData%PtfmFt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) + OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1137,18 +1090,13 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastTimeStep = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTimeStep = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Orca_UnPackMisc SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1314,8 +1262,8 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1344,14 +1292,14 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%SimNamePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SimNamePathLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%SimNamePath) + IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SimNamePathLen + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1408,12 +1356,6 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1428,8 +1370,8 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1470,14 +1412,14 @@ SUBROUTINE Orca_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) - DO I = 1, LEN(OutData%SimNamePath) - OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SimNamePathLen = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%SimNamePath) + OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SimNamePathLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1690,12 +1632,6 @@ SUBROUTINE Orca_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInput' @@ -1921,8 +1857,10 @@ SUBROUTINE Orca_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Orca_PackOutput @@ -1939,12 +1877,6 @@ SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2012,15 +1944,10 @@ SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Orca_UnPackOutput @@ -2115,8 +2042,8 @@ SUBROUTINE Orca_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackContState SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2132,12 +2059,6 @@ SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackContState' @@ -2151,8 +2072,8 @@ SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackContState SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2246,8 +2167,8 @@ SUBROUTINE Orca_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackDiscState SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2263,12 +2184,6 @@ SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackDiscState' @@ -2282,8 +2197,8 @@ SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackDiscState SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2377,8 +2292,8 @@ SUBROUTINE Orca_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackConstrState SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2394,12 +2309,6 @@ SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackConstrState' @@ -2413,8 +2322,8 @@ SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackConstrState @@ -2492,8 +2401,8 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2508,6 +2417,8 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE Orca_Input_ExtrapInterp1 @@ -2539,8 +2450,9 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp2' @@ -2562,6 +2474,8 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE Orca_Input_ExtrapInterp2 @@ -2641,12 +2555,12 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2659,15 +2573,15 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Orca_Output_ExtrapInterp1 @@ -2698,13 +2612,14 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2723,16 +2638,16 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Orca_Output_ExtrapInterp2 diff --git a/modules/orcaflex-interface/src/OutListParameters.xlsx b/modules/orcaflex-interface/src/OutListParameters.xlsx deleted file mode 100644 index c163568a1c..0000000000 Binary files a/modules/orcaflex-interface/src/OutListParameters.xlsx and /dev/null differ diff --git a/modules/servodyn/src/BladedInterface.f90 b/modules/servodyn/src/BladedInterface.f90 index 98b9e65bd1..8fd332cdec 100644 --- a/modules/servodyn/src/BladedInterface.f90 +++ b/modules/servodyn/src/BladedInterface.f90 @@ -29,22 +29,22 @@ MODULE BladedInterface IMPLICIT NONE - TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '14-Oct-2015' ) + TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '' ) !> Definition of the DLL Interface (from Bladed): !! Note that aviFAIL and avcMSG should be used as INTENT(OUT), but I'm defining them INTENT(INOUT) just in case the compiler decides to reinitialize something that's INTENT(OUT) ABSTRACT INTERFACE - SUBROUTINE BladedDLL_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) + SUBROUTINE BladedDLL_Legacy_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) USE, INTRINSIC :: ISO_C_Binding REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) !< DATA INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (in:Simulation RootName; out:Name:Units; of logging channels) CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) - END SUBROUTINE BladedDLL_Procedure + END SUBROUTINE BladedDLL_Legacy_Procedure SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SC, to_SC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) USE, INTRINSIC :: ISO_C_Binding @@ -54,13 +54,22 @@ SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SC, to_SC, aviFAIL, accINFILE, REAL(C_FLOAT), INTENT(INOUT) :: to_SC (*) !< DATA to the supercontroller INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) END SUBROUTINE BladedDLL_SC_Procedure - - END INTERFACE + FUNCTION BladedDLL_CONTROLLER_Procedure ( turbine_id ) BIND (C) ! from Bladed 4.8 API + USE, INTRINSIC :: ISO_C_Binding + +! INTEGER(C_SIZE_T), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (as written in Bladed's API) + TYPE(C_PTR), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (using standard Fortran nomenclature for ISO C BINDING) + INTEGER(C_INT) :: BladedDLL_CONTROLLER_Procedure ! an integer determining the status of the call (see aviFAIL) + + END FUNCTION BladedDLL_CONTROLLER_Procedure + + END INTERFACE + #ifdef STATIC_DLL_LOAD INTERFACE @@ -89,39 +98,120 @@ END SUBROUTINE DISCON ! Some constants for the Interface: INTEGER(IntKi), PARAMETER :: R_v36 = 85 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.6 - INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 and later + INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 - 4.2 + INTEGER(IntKi), PARAMETER :: R_v43 = 165 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 4.3 and later - INTEGER(IntKi), PARAMETER :: R = R_v4 !< start of the generator speed look-up table - + INTEGER(IntKi), PARAMETER :: R = R_v43 !< start of the generator speed look-up table +#ifdef STATIC_DLL_LOAD + INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 0 +#else + INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 300 +#endif + + !! GH_DISCON_SIMULATION_STATUS - Flag returned by simulation from GetSimulationStatus. Descriptions taken from the user manual. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_FINALISING = -1 ! Final call at the end of the simulation. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_INITIALISING = 0 ! First call at time zero. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_DISCRETE_STEP = 1 ! Simulation discrete timestep. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_CHECKPOINT = -8 ! Create a checkpoint file (extension to GH DISCON documentation) + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_RESTARTING = -9 ! Restart step (extension to GH DISCON documentation) + !! GH_DISCON_PITCH_CONTROL - Flag to specify whether the pitch is controlled collectively or individually. + INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_COLLECTIVE = 0 ! Pitch is controlled collectively - use GetCollectivePitchAngle and SetDemandedCollectivePitchAngle. + INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_INDIVIDUAL = 1 ! Pitch is controlled on each blade individually - use GetPitchAngle and SetDemandedPitchAngle. + !! GH_DISCON_YAW_CONTROL - Flag to represent whether the yaw is controlled by rate or torque. + INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_RATE = 0 ! Uses the yaw rate demand to control yaw. + INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_TORQUE = 1 ! Uses the yaw torque demand to control yaw. CONTAINS !================================================================================================================================== !> This SUBROUTINE is used to call the Bladed-style DLL. -SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) +SUBROUTINE CallBladedDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + + TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs + TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(BladedDLLType), TARGET, INTENT(INOUT) :: dll_data ! data type containing the inputs for the Bladed DLL interface + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) + + PROCEDURE(BladedDLL_CONTROLLER_Procedure), POINTER :: DLL_CONTROLLER ! The address of the CONTROLLER or CONTROLLER_INIT procedure in the Bladed DLL + INTEGER :: ProcedureIndex + INTEGER(C_INT) :: aviFAIL ! status returned from Bladed controller + TYPE(C_PTR) :: turbine_id + TYPE(BladedDLLType), POINTER :: dll_data_PTR ! pointer to data type containing the inputs for the Bladed DLL interface + + + if (p%UseLegacyInterface) then + if (present(ChannelNameUnit)) then + call CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + else + call CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg ) + end if + else + + if ( dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING ) then + ProcedureIndex = 2 ! initialization call to CONTROLLER or CONTROLLER_INIT + else + ProcedureIndex = 1 ! normal call to CONTROLLER + end if + + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(ProcedureIndex), DLL_CONTROLLER) + dll_data_PTR => dll_data + turbine_id = C_LOC(dll_data_PTR) + + aviFAIL = DLL_CONTROLLER ( turbine_id ) + + ! these values are set in the controller: + ErrStat = dll_data%ErrStat + ErrMsg = dll_data%ErrMsg + + ! but we must also check the return value from the controller function (i'd think they would be the same) + IF ( aviFAIL /= 0 ) THEN + + IF ( aviFAIL > 0 ) THEN ! warning + ErrStat = max(ErrStat,ErrID_Info) + ELSE ! error + ErrStat = ErrID_Fatal + END IF + + END IF + + IF (ErrStat /= ErrID_None) THEN + ErrMsg = trim(p%DLL_Trgt%ProcName(ProcedureIndex))//trim(ErrMsg) + END IF + + end if - ! Passed Variables: + if ( dll_data%SimStatus == GH_DISCON_STATUS_FINALISING ) then + dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING + else + dll_data%SimStatus = GH_DISCON_STATUS_DISCRETE_STEP + end if + +END SUBROUTINE CallBladedDLL +!================================================================================================================================== +SUBROUTINE CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + ! Passed Variables: TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs - TYPE(DLL_Type), INTENT(IN ) :: DLL ! The DLL to be called. - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays !REAL(SiKi), INTENT(INOUT) :: avrSWAP (*) ! The swap array, used to pass data to, and receive data from, the DLL controller. !INTEGER(B1Ki), INTENT(IN ) :: accINFILE (*) ! The address of the first record of an array of 1-byte CHARACTERs giving the name of the parameter input file, 'DISCON.IN'. - !INTEGER(B1Ki), INTENT(IN ) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. + !INTEGER(B1Ki), INTENT(INOUT) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) + ! Local Variables: INTEGER(C_INT) :: aviFAIL ! A flag used to indicate the success of this DLL call set as follows: 0 if the DLL call was successful, >0 if the DLL call was successful but cMessage should be issued as a warning messsage, <0 if the DLL call was unsuccessful or for any other reason the simulation is to be stopped at this point with cMessage as the error message. - CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(p%DLL_InFile)+1) ! INFILE - CHARACTER(KIND=C_CHAR) :: avcOUTNAME(LEN_TRIM(p%RootName)+1) ! OUTNAME (Simulation RootName) - CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - + CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(dll_data%DLL_InFile)+1) ! INFILE + CHARACTER(KIND=C_CHAR) :: avcOUTNAME(p%avcOUTNAME_LEN) ! OUTNAME (in: Simulation RootName; out: string for logging channels Name:Units;) + CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - PROCEDURE(BladedDLL_Procedure), POINTER :: DLL_Subroutine ! The address of the procedure in the Bladed DLL - PROCEDURE(BladedDLL_SC_Procedure),POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL + PROCEDURE(BladedDLL_Legacy_Procedure), POINTER :: DLL_Legacy_Subroutine ! The address of the (legacy DISCON) procedure in the Bladed DLL + PROCEDURE(BladedDLL_SC_Procedure), POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL ! initialize aviFAIL @@ -129,9 +219,9 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) !Convert to C-type characters: the "C_NULL_CHAR" converts the Fortran string to a C-type string (i.e., adds //CHAR(0) to the end) - avcOUTNAME = TRANSFER( TRIM(p%RootName)//C_NULL_CHAR, avcOUTNAME ) - accINFILE = TRANSFER( TRIM(p%DLL_InFile)//C_NULL_CHAR, accINFILE ) - avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... + avcOUTNAME = TRANSFER( TRIM(dll_data%RootName)//C_NULL_CHAR, avcOUTNAME ) + accINFILE = TRANSFER( TRIM(dll_data%DLL_InFile)//C_NULL_CHAR, accINFILE ) + avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... #ifdef STATIC_DLL_LOAD @@ -147,15 +237,13 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) IF ( ALLOCATED(dll_data%SCoutput) ) THEN ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( DLL%ProcAddr(1), DLL_SC_Subroutine) + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_SC_Subroutine) CALL DLL_SC_Subroutine ( dll_data%avrSWAP, u%SuperController, dll_data%SCoutput, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) ELSE - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( DLL%ProcAddr(1), DLL_Subroutine) - CALL DLL_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) - + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_Legacy_Subroutine) + CALL DLL_Legacy_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) END IF #endif @@ -175,12 +263,17 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = '' END IF + + IF (PRESENT(ChannelNameUnit)) THEN + ChannelNameUnit = TRANSFER(avcOUTNAME,ChannelNameUnit) !convert C character array to Fortran string + CALL RemoveNullChar( ChannelNameUnit ) + END IF RETURN -END SUBROUTINE CallBladedDLL +END SUBROUTINE CallBladedLegacyDLL !================================================================================================================================== !> This routine initializes variables used in the Bladed DLL interface. -SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) +SUBROUTINE BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat, ErrMsg) TYPE(SrvD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters @@ -188,12 +281,13 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - + INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred @@ -210,61 +304,71 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) CALL DispNVD( BladedInterface_Ver ) ! Display the version of this interface - p%Ptch_Cntrl = InputFileData%Ptch_Cntrl - p%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - p%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) - p%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) - p%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) - p%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) - p%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque (Nm) - p%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) - p%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) - p%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) - p%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) - p%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) - p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) - - p%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) - p%DLL_InFile = InputFileData%DLL_InFile - - p%DLL_DT = InputFileData%DLL_DT - IF ( .NOT. EqualRealNos( NINT( p%DLL_DT / p%DT ) * p%DT, p%DLL_DT ) ) THEN + p%UseLegacyInterface = InputFileData%UseLegacyInterface + + m%dll_data%Ptch_Cntrl = InputFileData%Ptch_Cntrl + m%dll_data%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) + m%dll_data%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) + m%dll_data%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) + m%dll_data%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) + m%dll_data%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) + m%dll_data%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque above rated (Nm) + m%dll_data%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) + m%dll_data%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) + m%dll_data%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) + m%dll_data%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) + m%dll_data%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) + p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) + + m%dll_data%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) + + m%dll_data%DLL_InFile = InputFileData%DLL_InFile + m%dll_data%RootName = p%RootName + p%avcOUTNAME_LEN = max( LEN_TRIM(m%dll_data%RootName), MaxLoggingChannels*2*(1+ChanLen) ) + 1 ! = max( size of input, size of output ) + c_null_char + + m%dll_data%DLL_DT = InputFileData%DLL_DT ! Communication interval (sec) + p%DLL_n = NINT( m%dll_data%DLL_DT / p%DT ) + IF ( .NOT. EqualRealNos( p%DLL_n * p%DT, m%dll_data%DLL_DT ) ) THEN CALL CheckError( ErrID_Fatal, 'DLL_DT must be an integer multiple of DT.' ) END IF - IF ( p%DLL_DT < EPSILON( p%DLL_DT ) ) THEN + IF ( m%dll_data%DLL_DT < EPSILON( m%dll_data%DLL_DT ) ) THEN CALL CheckError( ErrID_Fatal, 'DLL_DT must be larger than zero.' ) END IF - + p%DLL_Ramp = InputFileData%DLL_Ramp - p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL - m%dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit + p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL if (InputFileData%BPCutoff < EPSILON( InputFileData%BPCutoff )) CALL CheckError( ErrID_Fatal, 'BPCutoff must be greater than 0.') - IF ( p%Ptch_Cntrl /= 1_IntKi .AND. p%Ptch_Cntrl /= 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 or 1.') + IF ( m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_INDIVIDUAL .AND. m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN + CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 (collective) or 1 (individual).') + RETURN END IF + m%dll_data%Yaw_Cntrl = GH_DISCON_YAW_CONTROL_RATE ! currently only available option + m%dll_data%OverrideYawRateWithTorque = .false. + + CALL AllocAry( m%dll_data%BlPitchInput, p%NumBl, 'm%dll_data%BlPitchInput', ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) - IF ( p%DLL_NumTrq < 0_IntKi ) THEN + IF ( m%dll_data%DLL_NumTrq < 0_IntKi ) THEN CALL CheckError( ErrID_Fatal, 'DLL_NumTrq must not be less than zero.') - ELSEIF ( p%DLL_NumTrq > 0 ) THEN - CALL AllocAry( p%GenSpd_TLU, p%DLL_NumTrq, 'GenSpd_TLU', ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - CALL AllocAry( p%GenTrq_TLU, p%DLL_NumTrq, 'GenTrq_TLU',ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - - p%GenSpd_TLU = InputFileData%GenSpd_TLU ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) - p%GenTrq_TLU = InputFileData%GenTrq_TLU ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) - - END IF + ELSEIF ( m%dll_data%DLL_NumTrq > 0 ) THEN + m%dll_data%Gain_OM = 0.0 ! 0.0 indicates that torque-speed table look-up is selected + + CALL MOVE_ALLOC(InputFileData%GenSpd_TLU, m%dll_data%GenSpd_TLU) ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) + CALL MOVE_ALLOC(InputFileData%GenTrq_TLU, m%dll_data%GenTrq_TLU) ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) + END IF + IF ( ErrStat >= AbortErrLev ) RETURN - CALL AllocAry( m%dll_data%avrSwap, R+(2*p%DLL_NumTrq)-1, 'avrSwap', ErrStat2, ErrMsg2 ) + ! Set status flag and initialize avrSWAP: + m%dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING + + CALL AllocAry( m%dll_data%avrSwap, R+(2*m%dll_data%DLL_NumTrq)-1 + MaxLoggingChannels, 'avrSwap', ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN + m%dll_data%avrSWAP = 0.0 IF (ALLOCATED(y%SuperController)) THEN CALL AllocAry( m%dll_data%SCoutput, SIZE(y%SuperController), 'm%dll_data%SuperController', ErrStat2, ErrMsg2 ) @@ -275,12 +379,10 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) ! Initialize dll data stored in OtherState - m%dll_data%GenState = 1 - m%dll_data%GenTrq = 0.0 - m%dll_data%YawRateCom = 0.0 - m%dll_data%HSSBrFrac = 0.0 + m%dll_data%initialized = .FALSE. + + - #ifdef STATIC_DLL_LOAD ! because OpenFOAM needs the MPI task to copy the library, we're not going to dynamically load it; it needs to be loaded at runtime. p%DLL_Trgt%FileName = '' @@ -290,25 +392,57 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) p%DLL_Trgt%FileName = InputFileData%DLL_FileName - p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one - p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName + if (.not. p%UseLegacyInterface) then + p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only two + p%DLL_Trgt%ProcName(1) = "CONTROLLER" + p%DLL_Trgt%ProcName(2) = "CONTROLLER_INIT" + + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) + if (ErrStat2 > ErrID_Fatal) then ! it loaded the DLL but didn't find the INIT routine + p%DLL_Trgt%ProcName(2) = p%DLL_Trgt%ProcName(1) ! we won't call the separate controller_init routine the first time + p%DLL_Trgt%ProcAddr(2) = p%DLL_Trgt%ProcAddr(1) + elseif (ErrStat2 == ErrID_Fatal) then + CALL CheckError(ErrID_Info,'Error opening BLADED interface DLL. Checking for legacy DLL.') + CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) + p%UseLegacyInterface = .true. ! Bladed checks for the legacy version if it can't find the CONTROLL function in the DLL, so that's what we'll have to do, too + end if + end if + + if (p%UseLegacyInterface) then + p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one + p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName + + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL WrScr('Using legacy Bladed DLL interface.') + end if + +!-------------------------------------- + p%NumOuts_DLL = 0 +#ifdef LOAD_DLL_TWICE_FOR_LOGGING_CHANNELS + CALL GetBladedLoggingChannels(u,p,m, ErrStat2, ErrMsg2) ! this calls the DLL, but we don't have the correct inputs for a time step, so we'll close the DLL and start it again + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! close and reload library here... + ! (if the DLL could be guaranteed to not do anything with the + ! inputs on the initial step, we could avoid this this part) + + CALL BladedInterface_End(u, p, m, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN #endif - - ! Set status flag: - !m%dll_data%avrSWAP( 1) = 0.0 - m%dll_data%avrSWAP = 0.0 - !CALL Fill_avrSWAP( 0_IntKi, t, u, p, LEN(ErrMsg), m%dll_data ) ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - - - !CALL CallBladedDLL(p%DLL_Trgt, m%dll_data, ErrStat2, ErrMsg2) - ! CALL CheckError(ErrStat2,ErrMsg2) - ! IF ( ErrStat >= AbortErrLev ) RETURN - ! +!-------------------------------------- +#endif + + CONTAINS !............................................................................................................................... SUBROUTINE CheckError(ErrID,Msg) @@ -343,6 +477,172 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError END SUBROUTINE BladedInterface_Init !================================================================================================================================== +SUBROUTINE GetBladedLoggingChannels(u,p,m, ErrStat, ErrMsg) + + TYPE(SrvD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Initial misc (optimization) variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + + INTEGER(IntKi) :: StartIndx ! starting index used to parse name/unit from Bladed DLL + INTEGER(IntKi) :: Indx ! index used to parse name/unit from Bladed DLL + INTEGER(IntKi) :: i ! The error status code + INTEGER(IntKi) :: ErrStat2 ! The error status code + CHARACTER( p%avcOUTNAME_LEN ) :: LoggingChannelStr ! The error message, if an error occurred + CHARACTER(*), PARAMETER :: RoutineName = "GetBladedLoggingChannels" + + + CALL Fill_CONTROL_vars( 0.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) + + if (p%UseLegacyInterface) then + + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg, LoggingChannelStr) + IF ( ErrStat >= AbortErrLev ) RETURN + + p%NumOuts_DLL = NINT( m%dll_data%avrSWAP(65) ) ! number of channels returned for logging + + ALLOCATE ( m%dll_data%LogChannels_OutParam(p%NumOuts_DLL) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels name array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ALLOCATE( m%dll_data%LogChannels(p%NumOuts_DLL), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ! get names and units of channels + do i=1,p%NumOuts_DLL + m%dll_data%LogChannels_OutParam(i)%Indx = 0 + m%dll_data%LogChannels_OutParam(i)%SignM = 1 + m%dll_data%LogChannels_OutParam(i)%Name = "LogChan"//trim(num2lstr(i)) + m%dll_data%LogChannels_OutParam(i)%Units = "Unknown" + end do + + StartIndx = 1 + do i=1,p%NumOuts_DLL + + ! parse the channel name + indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ':' ) - 1 + if (indx > len(LoggingChannelStr) .or. indx < 1) then + call SetErrStat( ErrID_Severe,"Error getting logging channel name.", ErrStat, ErrMsg, RoutineName ) + endif + + m%dll_data%LogChannels_OutParam(I)%Name = LoggingChannelStr(StartIndx:indx-1) + StartIndx = indx + 1 + + ! parse the channel units + indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ';' ) - 1 + if (indx > len(LoggingChannelStr) .or. indx < 1) then + call SetErrStat( ErrID_Severe,"Error getting logging channel units.", ErrStat, ErrMsg, RoutineName ) + endif + + m%dll_data%LogChannels_OutParam(I)%Units = LoggingChannelStr(StartIndx:indx-1) + StartIndx = indx + 1 + end do + + !todo: make sure trim(m%dll_data%LogChannels_OutParam(i)%Name) does not contain spaces; replace with '_' if necessary + + else + + + ALLOCATE( m%dll_data%LogChannels( MaxLoggingChannels), & + m%dll_data%LogChannels_OutParam(MaxLoggingChannels), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) + IF ( ErrStat >= AbortErrLev ) RETURN + + p%NumOuts_DLL = m%dll_data%NumLogChannels ! set this as a parameter in case the DLL changes the value during the simulation + + end if + + + ! convert Bladed-allowed unit specifiers to actual units + do i=1,p%NumOuts_DLL + select case (m%dll_data%LogChannels_OutParam(I)%Units) + case('1/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'Hz' + case('A') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad' + case('A/P') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/W' + case('A/PT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws' + case('A/PTT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws^2' + case('A/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s' + case('A/TT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s^2' + case('F') + m%dll_data%LogChannels_OutParam(I)%Units = 'N' + case('F/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'N/m' + case('F/LL') + m%dll_data%LogChannels_OutParam(I)%Units = 'N/m^2' + case('FL') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm' + case('FL/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/rad' + case('FL/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/m' + case('FLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm^2' + case('FLT/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nms/rad' + case('FLTT/AA') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nms^2/rad^2' + case('I') + m%dll_data%LogChannels_OutParam(I)%Units = 'A' + case('L') + m%dll_data%LogChannels_OutParam(I)%Units = 'm' + case('L/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'm/s' + case('L/TT') + m%dll_data%LogChannels_OutParam(I)%Units = 'm/s^2' + case('LLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'm^3' + case('LLL/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'm^3/rad' + case('M') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg' + case('M/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m' + case('M/LLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m^3' + case('M/LT') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/ms' + case('MLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'kgm^2' + case('N') + m%dll_data%LogChannels_OutParam(I)%Units = '-' + case('P') + m%dll_data%LogChannels_OutParam(I)%Units = 'W' + case('PT') + m%dll_data%LogChannels_OutParam(I)%Units = 'J' + case('Q') + m%dll_data%LogChannels_OutParam(I)%Units = 'VAr' + case('T') + m%dll_data%LogChannels_OutParam(I)%Units = 's' + case('VI') + m%dll_data%LogChannels_OutParam(I)%Units = 'VA' + end select + + end do + +END SUBROUTINE GetBladedLoggingChannels +!================================================================================================================================== + !> This routine calls the DLL for the final time (if it was previously called), and frees the dynamic library. SUBROUTINE BladedInterface_End(u, p, m, ErrStat, ErrMsg) @@ -358,17 +658,16 @@ SUBROUTINE BladedInterface_End(u, p, m, ErrStat, ErrMsg) ! call DLL final time, but skip if we've never called it if (allocated(m%dll_data%avrSWAP)) then - IF ( .NOT. EqualRealNos( m%dll_data%avrSWAP( 1), 0.0_SiKi ) ) THEN - m%dll_data%avrSWAP( 1) = -1.0 ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - !CALL Fill_avrSWAP( -1_IntKi, -10.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) - - CALL CallBladedDLL(u, p%DLL_Trgt, m%dll_data, p, ErrStat, ErrMsg) + IF ( m%dll_data%SimStatus /= GH_DISCON_STATUS_INITIALISING ) THEN + m%dll_data%SimStatus = GH_DISCON_STATUS_FINALISING + m%dll_data%avrSWAP(1) = m%dll_data%SimStatus ! we aren't calling fill_avrSWAP, so set this manually + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) END IF end if CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - IF (ErrStat2 /= ErrID_None) THEN - ErrStat = MAX(ErrStat, ErrStat2) + IF (ErrStat2 /= ErrID_None) THEN + ErrStat = MAX(ErrStat, ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) END IF @@ -388,7 +687,7 @@ SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, ErrStat, ErrMsg) ! local variables: INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - + character(*), parameter :: RoutineName = 'BladedInterface_CalcOutput' ! Initialize error values: ErrStat = ErrID_None @@ -396,41 +695,31 @@ SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, ErrStat, ErrMsg) ! Set the input values of the avrSWAP array: - CALL Fill_avrSWAP( t, u, p, LEN(ErrMsg), m%dll_data ) - + CALL Fill_CONTROL_vars( t, u, p, LEN(ErrMsg), m%dll_data ) + + #ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat, ErrMsg ) -CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) +CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) write(58,'()') #endif - - + ! Call the Bladed-style DLL controller: - CALL CallBladedDLL(u, p%DLL_Trgt, m%dll_data, p, ErrStat, ErrMsg) + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) IF ( ErrStat >= AbortErrLev ) RETURN #ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat, ErrMsg ) -CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) +CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) write(59,'()') #endif - - - !bjj: setting this after the call so that the first call is with avrSWAP(1)=0 [apparently it doesn't like to be called at initialization.... but maybe we can fix that later] - m%dll_data%avrSWAP( 1) = 1.0 ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - + ! Get the output values from the avrSWAP array: + + CALL CheckDLLReturnValues( p, m%dll_data, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Retrieve_avrSWAP( p, m%dll_data, ErrStat2, ErrMsg2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//TRIM(ErrMsg2) - ErrStat = MAX(ErrStat, ErrStat2) - IF ( ErrStat >= AbortErrLev ) RETURN - END IF - - -END SUBROUTINE BladedInterface_CalcOutput +END SUBROUTINE BladedInterface_CalcOutput !================================================================================================================================== !> This routine fills the avrSWAP array with its inputs, as described in Appendices A and B of the Bladed User Manual of Bladed !! version 3.81. @@ -443,90 +732,76 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) -! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL ! local variables: INTEGER(IntKi) :: I ! Loop counter - - !! Set the values of the avrSWAP array that vary during a simulation - - !IF ( StatFlag == 0 ) ! Initialization flag - ! avrSWAP = 0.0 - ! - ! - ! - !ELSE - + !> The following are values ServoDyn sends to the Bladed DLL. !! For variables returned from the DLL, see bladedinterface::retrieve_avrswap. - !dll_data%avrSWAP( 1) = REAL(StatFlag, SiKi) + dll_data%avrSWAP( 1) = dll_data%SimStatus !> * Record 1: Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) dll_data%avrSWAP( 2) = REAL(t, SiKi) !> * Record 2: Current time (sec) [t in single precision] - dll_data%avrSWAP( 3) = p%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] + dll_data%avrSWAP( 3) = dll_data%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] dll_data%avrSWAP( 4) = u%BlPitch(1) !> * Record 4: Blade 1 pitch angle (rad) [SrvD input] - dll_data%avrSWAP( 5) = p%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] - dll_data%avrSWAP( 6) = p%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] - dll_data%avrSWAP( 7) = p%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] - dll_data%avrSWAP( 8) = p%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] - dll_data%avrSWAP( 9) = p%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] + dll_data%avrSWAP( 5) = dll_data%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] + dll_data%avrSWAP( 6) = dll_data%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] + dll_data%avrSWAP( 7) = dll_data%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] + dll_data%avrSWAP( 8) = dll_data%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] + dll_data%avrSWAP( 9) = dll_data%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] dll_data%avrSWAP(10) = 0.0 !> * Record 10: 0 = pitch position actuator, 1 = pitch rate actuator (-) [must be 0 for ServoDyn] -!bjj: record 11 technically needs the old demanded values (currently equivalent to this quantity) -! dll_data%avrSWAP(11) = u%BlPitch(1) ! Current demanded pitch angle (rad) -- I am sending the value for blade 1, in the absence of any more information provided in Bladed documentation - dll_data%avrSWAP(11) = dll_data%PrevBlPitch(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] + dll_data%avrSWAP(11) = dll_data%BlPitchCom(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] dll_data%avrSWAP(12) = 0.0 !> * Record 12: Current demanded pitch rate (rad/s) [always zero for ServoDyn] - dll_data%avrSWAP(13) = p%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter] + dll_data%avrSWAP(13) = dll_data%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter from input file] dll_data%avrSWAP(14) = u%RotPwr !> * Record 14: Measured shaft power (W) [SrvD input] - dll_data%avrSWAP(15) = u%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD input from previous step output; technically should be a state] - !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0] - IF ( p%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected - dll_data%avrSWAP(16) = p%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - ELSE ! Torque-speed table look-up selected - dll_data%avrSWAP(16) = 0.0 ! Optimal mode gain (Nm/(rad/s)^2) -- 0.0 indicates that torque-speed table look-up is selected - ENDIF - dll_data%avrSWAP(17) = p%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] - dll_data%avrSWAP(18) = p%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] - dll_data%avrSWAP(19) = p%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] + dll_data%avrSWAP(15) = dll_data%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD calculation from previous step; should technically be a state] + dll_data%avrSWAP(16) = dll_data%Gain_OM !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0 (already overwritten in Init routine)] + dll_data%avrSWAP(17) = dll_data%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] + dll_data%avrSWAP(18) = dll_data%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] + dll_data%avrSWAP(19) = dll_data%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] dll_data%avrSWAP(20) = u%HSS_Spd !> * Record 20: Measured generator speed (rad/s) [SrvD input] dll_data%avrSWAP(21) = u%RotSpeed !> * Record 21: Measured rotor speed (rad/s) [SrvD input] - dll_data%avrSWAP(22) = p%GenTrq_Dem !> * Record 22: Demanded generator torque (Nm) [SrvD GenTrq_Dem parameter] + dll_data%avrSWAP(22) = dll_data%GenTrq_Dem !> * Record 22: Demanded generator torque above rated (Nm) [SrvD GenTrq_Dem parameter from input file] !bjj: this assumes it is the value at the previous step; but we actually want the output GenTrq... - dll_data%avrSWAP(23) = u%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD input from previous step output; should technically be a state] + dll_data%avrSWAP(23) = dll_data%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD calculation from previous step; should technically be a state] dll_data%avrSWAP(24) = u%YawErr !> * Record 24: Measured yaw error (rad) [SrvD input] - IF ( p%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected + IF ( dll_data%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected dll_data%avrSWAP(25) = 0.0 ! Start of below-rated torque-speed look-up table (record no.) -- 0.0 indicates that torque-speed table look-up is not selected - dll_data%avrSWAP(26) = 0.0 ! No. of points in torque-speed look-up table (-) -- 0.0 indicates that torque-speed table look-up is not selected ELSE ! Torque-speed table look-up selected dll_data%avrSWAP(25) = R !> * Record 25: Start of below-rated torque-speed look-up table (record no.) [parameter \f$R\f$ (bladedinterface::r) or 0 if DLL_NumTrq == 0] - dll_data%avrSWAP(26) = p%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] ENDIF + dll_data%avrSWAP(26) = dll_data%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] dll_data%avrSWAP(27) = u%HorWindV !> * Record 27: Hub wind speed (m/s) [SrvD input] - dll_data%avrSWAP(28) = p%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] - dll_data%avrSWAP(29) = 0.0 !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] + dll_data%avrSWAP(28) = dll_data%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] + dll_data%avrSWAP(29) = dll_data%Yaw_Cntrl !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] !^^^ bjj: maybe torque control can be used in ServoDyn? can we specifiy yaw torque control? dll_data%avrSWAP(30) = u%RootMyc(1) !> * Record 30: Blade 1 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(31) = u%RootMyc(2) !> * Record 31: Blade 2 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(32) = u%RootMyc(3) !> * Record 32: Blade 3 root out-of-plane bending moment (Nm) [SrvD input] +IF ( p%NumBl > 1 ) THEN dll_data%avrSWAP(33) = u%BlPitch(2) !> * Record 33: Blade 2 pitch angle (rad) [SrvD input] -IF ( p%NumBl > 2 ) THEN +END IF +IF ( p%NumBl > 2 ) THEN dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] +! dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] END IF dll_data%avrSWAP(35) = dll_data%GenState !> * Record 35: Generator contactor (-) [GenState from previous call to DLL (initialized to 1)] - dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full) (-) [HSSBrFrac from previous call to DLL (initialized to 0)] +! record 36 is initialized to 0 (brake off); then we will keep the brake status set in previous call to DLL +! dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full), 16 = Get brake torque from record 107 (-) [HSSBrFrac from previous call to DLL (initialized to 0)] dll_data%avrSWAP(37) = u%YawAngle - p%NacYaw_North !> * Record 37: Nacelle yaw angle from North (rad) [ \f$ u\%YawAngle - p\%NacYaw\_North \f$ ] ! Records 38-48 are outputs [see Retrieve_avrSWAP()] - dll_data%avrSWAP(49) = REAL( ErrMsgSz ) + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(50) = REAL( LEN_TRIM(p%DLL_InFile) ) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(51) = REAL( LEN_TRIM(p%RootName) ) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(49) = ErrMsgSz + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(50) = LEN_TRIM(dll_data%DLL_InFile) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(51) = LEN_TRIM(dll_data%RootName) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] ! Record 52 is reserved for future use ! DLL interface version number (-) dll_data%avrSWAP(53) = u%YawBrTAxp !> * Record 53: Tower top fore-aft acceleration (m/s^2) [SrvD input] dll_data%avrSWAP(54) = u%YawBrTAyp !> * Record 54: Tower top side-to-side acceleration (m/s^2) [SrvD input] ! Records 55-59 are outputs [see Retrieve_avrSWAP()] dll_data%avrSWAP(60) = u%LSSTipPxa !> * Record 60: Rotor azimuth angle (rad) [SrvD input] dll_data%avrSWAP(61) = p%NumBl !> * Record 61: Number of blades (-) [SrvD NumBl parameter] - dll_data%avrSWAP(62) = 0.0 !> * Record 62: Maximum number of values which can be returned for logging (-) [currently set to 0] - dll_data%avrSWAP(63) = 0.0 !> * Record 63: Record number for start of logging output (-) [currently set to 0] - dll_data%avrSWAP(64) = 0.0 !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [currently set to 0] + dll_data%avrSWAP(62) = MaxLoggingChannels !> * Record 62: Maximum number of values which can be returned for logging (-) [set to parameter bladedinterface::maxloggingchannels] + dll_data%avrSWAP(63) = R + (2*dll_data%DLL_NumTrq) !> * Record 63: Record number for start of logging output (-) [set to R + (2*p\%DLL_NumTrq)] + dll_data%avrSWAP(64) = p%avcOUTNAME_LEN !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [set to bladedinterface::MaxLoggingChannels * (2+nwtc_base::chanlen) + 1 (we add one for the C NULL CHARACTER)] ! Record 65 is output [see Retrieve_avrSWAP()] ! Records 66-68 are reserved @@ -565,9 +840,9 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) dll_data%avrSWAP(117) = 0 !> * Record 117: Controller state [always set to 0] !> * Records \f$R\f$ through \f$R + 2*DLL\_NumTrq - 1\f$: torque-speed look-up table elements. - DO I = 1,p%DLL_NumTrq ! Loop through all torque-speed look-up table elements - dll_data%avrSWAP( R + (2*I) - 2 ) = p%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) - dll_data%avrSWAP( R + (2*I) - 1 ) = p%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) + DO I = 1,dll_data%DLL_NumTrq ! Loop through all torque-speed look-up table elements + dll_data%avrSWAP( R + (2*I) - 2 ) = dll_data%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) + dll_data%avrSWAP( R + (2*I) - 1 ) = dll_data%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) ENDDO @@ -580,6 +855,73 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) RETURN END SUBROUTINE Fill_avrSWAP +!================================================================================================================================== +!> This routine fills the dll_data variables that are used in the non-legacy version of the Bladed DLL interface with inputs, +!! as described in Appendices A and B of the Bladed User Manual of Bladed version 4.8. +SUBROUTINE Fill_CONTROL_vars( t, u, p, ErrMsgSz, dll_data ) + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) +! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL + + ! local variables: + INTEGER(IntKi) :: i ! Loop counter + INTEGER(IntKi) :: j ! Loop counter + + if (dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING) then + dll_data%avrSWAP = 0.0 + dll_data%NumLogChannels = 0 + + dll_data%GenState = 1 + dll_data%GenTrq = 0.0 + dll_data%YawRateCom = 0.0 + dll_data%HSSBrTrqDemand = 0.0 + dll_data%ShaftBrakeStatusBinaryFlag = 0 ! no brakes deployed + dll_data%HSSBrDeployed = .false. + + dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit + dll_data%BlPitchCom(1:p%NumBl) = p%BlPitchInit + end if + + call Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) ! we'll set the avrSWAP variable, for the legacy version of the DLL, too. + + !> The following are values ServoDyn sends to the Bladed DLL. + !! For variables returned from the DLL, see bladedinterface::retrieve_control_vars. + + dll_data%ErrMsg = '' + dll_data%ErrStat = ErrID_None + dll_data%OverrideYawRateWithTorque = .false. + + dll_data%CurrentTime = t ! Current time (sec) + dll_data%BlPitchInput(1:p%NumBl) = u%BlPitch(1:p%NumBl) ! current blade pitch (input) + dll_data%YawAngleFromNorth = u%YawAngle - p%NacYaw_North ! Nacelle yaw angle from North (rad) + dll_data%HorWindV = u%HorWindV ! Hub wind speed (m/s) + dll_data%HSS_Spd = u%HSS_Spd ! Measured generator speed (rad/s) + dll_data%YawErr = u%YawErr ! Measured yaw error (rad) + dll_data%RotSpeed = u%RotSpeed ! Measured rotor speed (rad/s) + dll_data%YawBrTAxp = u%YawBrTAxp ! Tower top fore-aft acceleration (m/s^2) + dll_data%YawBrTAyp = u%YawBrTAyp ! Tower top side-to-side acceleration (m/s^2) + dll_data%LSSTipMys = u%LSSTipMys ! Fixed hub My (GL co-ords) (Nm) + dll_data%LSSTipMzs = u%LSSTipMzs ! Fixed hub Mz (GL co-ords) (Nm) + dll_data%LSSTipPxa = u%LSSTipPxa ! Rotor azimuth angle (rad) + dll_data%Yaw = u%Yaw ! Current nacelle yaw (angular position) (rad) NEW TO DLL!!! + dll_data%YawRate = u%YawRate ! Current nacelle yaw rate (angular velocity) (rad/s) NEW TO DLL!!! + dll_data%LSSTipMya = u%LSSTipMya ! Rotating hub My (GL co-ords) (Nm) + dll_data%LSSTipMza = u%LSSTipMza ! Rotating hub Mz (GL co-ords) (Nm) + dll_data%YawBrMyn = u%YawBrMyn ! Yaw bearing My (GL co-ords) (Nm) + dll_data%YawBrMzn = u%YawBrMzn ! Yaw bearing Mz (GL co-ords) (Nm) + dll_data%RotPwr = u%RotPwr ! Measured shaft power (W) [SrvD input] + dll_data%NcIMURAxs = u%NcIMURAxs ! Nacelle roll acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system + dll_data%NcIMURAys = u%NcIMURAys ! Nacelle nodding acceleration (rad/s^2) + dll_data%NcIMURAzs = u%NcIMURAzs ! Nacelle yaw acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system + dll_data%LSSTipMxa = u%LSSTipMxa ! Shaft torque (=hub Mx for clockwise rotor) (Nm) + dll_data%RootMyc = u%RootMyc ! Blade root out-of-plane bending moment (Nm) [SrvD input] + dll_data%RootMxc = u%RootMxc ! Blade root in-plane bending moment (Nm) [SrvD input] + +END SUBROUTINE Fill_CONTROL_vars !================================================================================================================================== !> This routine retrieves the DLL return values from the avrSWAP array, as described in Appendices A and B of the Bladed User !! Manual of Bladed version 3.81. @@ -594,6 +936,7 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) ! local variables: INTEGER(IntKi) :: K ! Loop counter + CHARACTER(*), PARAMETER :: RoutineName = 'Retrieve_avrSWAP' ! Initialize ErrStat and ErrMsg @@ -611,44 +954,23 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 35: Generator contactor (-) [sent to DLL at the next call] dll_data%GenState = NINT( dll_data%avrSWAP(35) ) ! Generator contactor (-) - IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN - - ! Generator contactor indicates something other than off or main; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Only off and main generators supported in '//TRIM( GetNVD( BladedInterface_Ver ) )// & - '. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal - - END IF - !> * Record 36: Shaft brake status (-) [sent to DLL at the next call; anything other than 0 or 1 is an error] - dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) + !dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) + dll_data%ShaftBrakeStatusBinaryFlag = NINT(dll_data%avrSWAP(36)) - IF ( ( .NOT. EqualRealNos(dll_data%HSSBrFrac, 0.0_ReKi) ) .AND. & - ( .NOT. EqualRealNos(dll_data%HSSBrFrac, 1.0_ReKi) ) ) THEN - - ! Shaft brake status specified incorrectly; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Shaft brake status improperly set in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(36) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal - - END IF - !! Records 38-40 are reserved !> * Record 41: demanded yaw actuator torque [this output is ignored since record 29 is set to 0 by ServoDyn indicating yaw rate control] + dll_data%YawTorqueDemand = dll_data%avrSWAP(41) ! Records 42-46: demanded pitch positions or rates - IF ( p%Ptch_Cntrl /= 0_IntKi ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) + IF ( dll_data%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_INDIVIDUAL ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) !> * Records 42-44: Demanded Individual Pitch position (rad) (or pitch rate [rad/s]) DO K = 1,p%NumBl ! Loop through all blades avrSWAP(42), avrSWAP(43), and, if NumBl = 3, avrSWAP(44) dll_data%BlPitchCom(K) = dll_data%avrSWAP( 41 + K ) ! Demanded individual pitch position of blade K (rad) ENDDO ! K - blades - ELSE !IF ( p%Ptch_Cntrl == 0_IntKi ) THEN ! Collective pitch control + ELSE !IF ( p%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN ! Collective pitch control !> * Record 45: Demanded pitch angle (Collective pitch) (rad) dll_data%BlPitchCom = dll_data%avrSWAP(45) ! Demanded pitch angle (Collective pitch) (rad) @@ -662,39 +984,30 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 55: Pitch override [anything other than 0 is an error in ServoDyn] IF ( NINT( dll_data%avrSWAP(55) ) /= 0 ) THEN - ! Pitch override requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Built-in pitch unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(55) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Severe, 'Built-in pitch override unsupported. Set avrSWAP(55) to 0 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + END IF - + !> * Record 56: Torque override IF ( NINT( dll_data%avrSWAP(56) ) /= 0 ) THEN - ! Torque override requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Built-in torque unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(56) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Severe, 'Built-in torque override unsupported. Set avrSWAP(56) to 0 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + END IF !! Records 57-59 are reserved -!> * Record 65: Number of variables returned for logging [anything other than 0 is an error] - IF ( NINT( dll_data%avrSWAP(65) ) /= 0 ) THEN +!> * Record 65: Number of variables returned for logging [anything greater than MaxLoggingChannels is an error] + IF ( NINT( dll_data%avrSWAP(65) ) > MaxLoggingChannels ) THEN ! Return variables for logging requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Return variables unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(65) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Fatal, 'Return variables exceed maximum number allowed. Set avrSWAP(65) to a number no larger than '// & + trim(num2lstr(MaxLoggingChannels))//' in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) ENDIF @@ -707,10 +1020,21 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 98: Safety system number to activate; not used in ServoDyn !> * Records 102-104: Yaw control/stiffness/damping; ignored in ServoDyn - -!> * Record 107: Brake torque demand - dll_data%HSSBrTrqC = dll_data%avrSWAP(107) - + if (dll_data%avrSWAP(102)==4) then + dll_data%OverrideYawRateWithTorque = .true. + elseif (dll_data%avrSWAP(102)==0) then + dll_data%OverrideYawRateWithTorque = .false. + else + dll_data%OverrideYawRateWithTorque = .false. + CALL SetErrStat( ErrID_Severe, 'Invalid yaw control flag. Set avrSWAP(102) to 0 or 4 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + +!> * Record 107: Brake torque demand (used only when avrSWAP(36) is 16) + if (dll_data%ShaftBrakeStatusBinaryFlag == 16) then + dll_data%HSSBrTrqDemand = dll_data%avrSWAP(107) + end if + !> * Record 108: Yaw brake torque demand; ignored in ServoDyn !> * Records 120-129: User-defined variables 1-10; ignored in ServoDyn @@ -723,10 +1047,80 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Records 130-142: Reserved -!> * L1: variables for logging output; not yet implemented in ServoDyn +!> * L1: variables for logging output; + + do k=1,p%NumOuts_DLL + dll_data%LogChannels(k) = dll_data%avrSWAP( NINT(dll_data%avrSWAP(63))+k-1 ) + end do END SUBROUTINE Retrieve_avrSWAP !================================================================================================================================== +!> This routine checks that the values returned to FAST from the controller DLL (from either version of the interface) are valid +SUBROUTINE CheckDLLReturnValues( p, dll_data, ErrStat, ErrMsg ) + + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'CheckDLLReturnValues' + + ! Initialize ErrStat and ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + + if (p%UseLegacyInterface) then + CALL Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + end if + + + IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN + ! Generator contactor indicates something other than off or main; abort program + if (p%UseLegacyInterface) then + CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + else + CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Call SetGeneratorContactor() with generator_contactor set to 0 or 1 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + END IF + + + SELECT CASE (dll_data%ShaftBrakeStatusBinaryFlag) + CASE (0) + dll_data%HSSBrTrqDemand = 0.0_ReKi + dll_data%HSSBrDeployed = .false. + CASE (1) + if (.not. dll_data%HSSBrDeployed) then + dll_data%TimeHSSBrDeployed = dll_data%CurrentTime + dll_data%TimeHSSBrFullyDeployed = dll_data%TimeHSSBrDeployed + p%HSSBrDT + dll_data%HSSBrDeployed = .true. + dll_data%HSSBrTrqDemand = 0.0_ReKi + else + ! apply a linear ramp up to the maximum value + IF ( dll_data%CurrentTime < dll_data%TimeHSSBrFullyDeployed ) THEN + dll_data%HSSBrTrqDemand = ( dll_data%CurrentTime - dll_data%TimeHSSBrDeployed )/p%HSSBrDT * p%HSSBrTqF + ELSE ! Full braking torque + dll_data%HSSBrTrqDemand = p%HSSBrTqF + ENDIF + end if + CASE (16) + dll_data%HSSBrDeployed = .false. + ! do we need to check that dll_data%HSSBrTrqDemand is set properly???? + CASE DEFAULT + dll_data%HSSBrDeployed = .false. + + ! Fatal issue: shaft brake status specified incorrectly + if (p%UseLegacyInterface) then + CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Set avrSWAP(36) to 0, 1, or 16 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + else + CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Call SetShaftBrakeStatusBinaryFlag() with binary_brake_status set to 0 or 1 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + END SELECT + +END SUBROUTINE CheckDLLReturnValues +!================================================================================================================================== END MODULE BladedInterface diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 9eb2f276ec..ac0fd59c83 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -52,11 +52,11 @@ MODULE ServoDyn INTEGER, PARAMETER :: Indx_u_YawRate = 2 INTEGER, PARAMETER :: Indx_u_HSS_Spd = 3 - INTEGER, PARAMETER :: Indx_Y_BlPitchCom(3) = (/1,2,3/) - INTEGER, PARAMETER :: Indx_Y_YawMom = 4 - INTEGER, PARAMETER :: Indx_Y_GenTrq = 5 - INTEGER, PARAMETER :: Indx_Y_ElecPwr = 6 - INTEGER, PARAMETER :: Indx_Y_WrOutput = 6 ! last non-writeoutput variable + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_BlPitchCom(3) = (/1,2,3/) + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_YawMom = 4 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_GenTrq = 5 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_ElecPwr = 6 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_WrOutput = 6 ! last non-writeoutput variable ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" @@ -120,7 +120,7 @@ MODULE ServoDyn INTEGER(IntKi), PARAMETER :: TTMD_YQD = 15 ! Airfoil Control (might be used for flap actuation): - + INTEGER(IntKi), PARAMETER :: BlAirFlC1 = 16 INTEGER(IntKi), PARAMETER :: BlAirFlC2 = 17 INTEGER(IntKi), PARAMETER :: BlAirFlC3 = 18 @@ -145,6 +145,10 @@ MODULE ServoDyn INTEGER(IntKi), PARAMETER :: ControlMode_EXTERN = 4 !< The (ServoDyn-universal) control code for obtaining the control values from Simulink or Labivew INTEGER(IntKi), PARAMETER :: ControlMode_DLL = 5 !< The (ServoDyn-universal) control code for obtaining the control values from a Bladed-Style dynamic-link library + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_none = 0 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_yaw = 1 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_torque = 2 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_pitch = 3 ! ..... Public Subroutines ................................................................................................... @@ -207,6 +211,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO TYPE(TMD_InitInputType) :: TMD_InitInp ! data to initialize TMD module TYPE(TMD_InitOutputType) :: TMD_InitOut ! data from TMD module initialization (not used) INTEGER(IntKi) :: i ! loop counter + INTEGER(IntKi) :: j ! loop counter INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -233,11 +238,11 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%RootName = InitInp%Rootname ! FAST adds the '.SrvD' before calling this module p%NumBl = InitInp%NumBl - CALL SrvD_ReadInput( InitInp%InputFile, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) + CALL SrvD_ReadInput( InitInp, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - - CALL ValidatePrimaryData( InitInp, InputFileData, InitInp%NumBl, ErrStat2, ErrMsg2 ) + + CALL ValidatePrimaryData( InitInp, InputFileData, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -250,7 +255,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO !............................................................................................ ! Define parameters here: !............................................................................................ - CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) + CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN !p%DT = Interval @@ -374,24 +379,12 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO u%RotPwr = 0. u%HorWindV = 0. u%YawAngle = 0. - u%ElecPwr_prev = 0. - u%GenTrq_prev = 0. + m%dll_data%ElecPwr_prev = 0. + m%dll_data%GenTrq_prev = 0. - ! These are values from previous step. I'll initialize them here, though the glue code may not use it. - ! @TODO: these need to be removed because they break the framework (though they're only for the Bladed-style - ! DLL which also breaks the frameowrk) - y%ElecPwr = u%ElecPwr_prev - y%GenTrq = u%GenTrq_prev - - !............................................................................................ ! Define system output initializations (set up mesh) here: !............................................................................................ - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - y%WriteOutput = 0 - CALL AllocAry( y%BlPitchCom, p%NumBl, 'BlPitchCom', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -417,34 +410,6 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO END IF - !............................................................................................ - ! Define initialization-routine output here: - !............................................................................................ - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - do i=1,p%NumOuts - InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name - InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units - end do - - - InitOut%Ver = SrvD_Ver - - InitOut%UseHSSBrake = p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax - - IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN - InitOut%CouplingScheme = ExplicitLoose - ! CALL CheckError( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& - ! //'requires an explicit-loose coupling scheme.' ) - ELSE - InitOut%CouplingScheme = ExplicitLoose - END IF - !............................................................................................ ! tip brakes - this may be added back, later, so we'll keep these here for now !............................................................................................ @@ -464,6 +429,11 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO OtherState%TTpBrFl = HUGE(OtherState%TTpBrFl) !basically never deploy them. Eventually this will be added back? !OtherState%TTpBrFl = InputFileData%TTpBrFl + p%TpBrDT + + !............................................................................................ + ! yaw control integrated command angle + !............................................................................................ + OtherState%YawPosComInt = p%YawNeut !............................................................................................ @@ -480,18 +450,19 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO IF ( p%UseBladedInterface ) THEN - p%AirDens = InitInp%AirDens + p%AirDens = InitInp%AirDens p%AvgWindSpeed = InitInp%AvgWindSpeed - CALL BladedInterface_Init(u, p, m, y, InputFileData, ErrStat2, ErrMsg2 ) + CALL BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - m%LastTimeCalled = - p%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. + m%LastTimeCalled = - m%dll_data%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. m%LastTimeFiltered = - p%DT ! we'll initialize the last time the DLL was filtered as -1 DT. m%FirstWarn = .TRUE. - ELSE + m%dll_data%DLL_DT = p%DT ! DLL_DT is used to compute the pitch rate and acceleration outputs + p%DLL_n = 1 ! Without a call to the DLL, update the history every time step p%DLL_Trgt%FileName = "" p%DLL_Trgt%ProcName = "" @@ -546,36 +517,40 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO !............................................................................................ ! Set Init outputs for linearization (after TMD, in case we ever add the TMD to the linearization features): !............................................................................................ - + xd%CtrlOffset = 0.0_ReKi ! initialize before first use with TrimCase in linearization + p%TrimCase = InitInp%TrimCase + p%TrimGain = InitInp%TrimGain + p%RotSpeedRef = InitInp%RotSpeedRef + if (InitInp%Linearize) then ! If the module does allow linearization, return the appropriate Jacobian row/column names here: ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u - CALL AllocAry( InitOut%RotFrame_y, 6+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%RotFrame_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%LinNames_y, 6+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%LinNames_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - do i=1,size(Indx_Y_BlPitchCom) - InitOut%LinNames_y(Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' - InitOut%RotFrame_y(Indx_Y_BlPitchCom(i)) = .true. + do i=1,size(SrvD_Indx_Y_BlPitchCom) + InitOut%LinNames_y(SrvD_Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' + InitOut%RotFrame_y(SrvD_Indx_Y_BlPitchCom(i)) = .true. end do - InitOut%LinNames_y(Indx_Y_YawMom) = 'YawMom, Nm' - InitOut%RotFrame_y(Indx_Y_YawMom) = .false. + InitOut%LinNames_y(SrvD_Indx_Y_YawMom) = 'YawMom, Nm' + InitOut%RotFrame_y(SrvD_Indx_Y_YawMom) = .false. - InitOut%LinNames_y(Indx_Y_GenTrq) = 'GenTrq, Nm' - InitOut%RotFrame_y(Indx_Y_GenTrq) = .false. + InitOut%LinNames_y(SrvD_Indx_Y_GenTrq) = 'GenTrq, Nm' + InitOut%RotFrame_y(SrvD_Indx_Y_GenTrq) = .false. + + InitOut%LinNames_y(SrvD_Indx_Y_ElecPwr) = 'ElecPwr, W' + InitOut%RotFrame_y(SrvD_Indx_Y_ElecPwr) = .false. - InitOut%LinNames_y(Indx_Y_ElecPwr) = 'ElecPwr, W' - InitOut%RotFrame_y(Indx_Y_ElecPwr) = .false. - do i=1,p%NumOuts - InitOut%LinNames_y(i+Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - InitOut%RotFrame_y(i+Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands + InitOut%LinNames_y(i+SrvD_Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + InitOut%RotFrame_y(i+SrvD_Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands end do @@ -596,8 +571,52 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%LinNames_u(Indx_u_HSS_Spd) = 'HSS_Spd, rad/s' InitOut%RotFrame_u = .false. ! none of these are in the rotating frame InitOut%IsLoad_u = .false. ! none of these linearization inputs are loads - + + else + + p%TrimCase = TrimCase_none + end if + + + !............................................................................................ + ! Define initialization-routine output here: + !............................................................................................ + CALL AllocAry( y%WriteOutput, p%NumOuts+p%NumOuts_DLL, 'WriteOutput', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + y%WriteOutput = 0 + + CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts+p%NumOuts_DLL, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts+p%NumOuts_DLL, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + do i=1,p%NumOuts + InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name + InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units + end do + + j=p%NumOuts + do i=1,p%NumOuts_DLL + j = j + 1 + InitOut%WriteOutputHdr(j) = m%dll_data%LogChannels_OutParam(i)%Name + InitOut%WriteOutputUnt(j) = m%dll_data%LogChannels_OutParam(i)%Units + end do + + InitOut%Ver = SrvD_Ver + + InitOut%UseHSSBrake = (p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax) .or. p%HSSBrMode == ControlMode_DLL + + IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN + InitOut%CouplingScheme = ExplicitLoose + ! CALL CheckError( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& + ! //'requires an explicit-loose coupling scheme.' ) + ELSE + InitOut%CouplingScheme = ExplicitLoose + END IF !............................................................................................ @@ -620,7 +639,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -747,6 +766,7 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: order TYPE(SrvD_InputType) :: u_interp ! interpolated input + ! Local variables: INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) @@ -820,34 +840,51 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, END IF - ! Get appropriate value of input for the filter in discrete states - ! this works only for the DLL at this point, so we're going to move it there>>>>>>>>>>>>>>> - - ! - !CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - !............................................................................................................................... - ! get inputs at t+dt: + ! get inputs at t: !............................................................................................................................... - t_next = t+p%dt - CALL SrvD_CopyInput( Inputs(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF + + CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !............................................................................................................................... + ! update discrete states: + !............................................................................................................................... + ! 1. Get appropriate value of input for the filter in discrete states (this works only for the DLL at this point, so we're going to move it there) + ! 2. Update control offset for trim solutions + + CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !............................................................................................................................... + ! get inputs at t+dt: + !............................................................................................................................... + t_next = t+p%dt + CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t_next, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (p%UseBladedInterface) THEN + CALL DLL_controller_call(t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + END IF !............................................................................................................................... ! update remaining states to values at t+dt: !............................................................................................................................... - ! Torque control + ! Torque control: CALL Torque_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -864,6 +901,23 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, CALL TipBrake_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + !................................................................... + ! Compute ElecPwr and GenTrq for controller (and DLL needs this saved): + !................................................................... + IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. + CALL CalculateTorque( t, u_interp, p, m, m%dll_data%GenTrq_prev, m%dll_data%ElecPwr_prev, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ELSE ! Generator is off line. + m%dll_data%GenTrq_prev = 0.0_ReKi + m%dll_data%ElecPwr_prev = 0.0_ReKi + ENDIF + !............................................................................................................................... CALL Cleanup() @@ -887,6 +941,61 @@ END SUBROUTINE Cleanup END SUBROUTINE SrvD_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for deciding if Bladed-style DLL controller should be called +SUBROUTINE DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'DLL_controller_call' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + ! we should be calling this routine ONLY when the following statement is true: + !IF ( p%UseBladedInterface ) THEN + + IF ( .NOT. EqualRealNos( t - m%dll_data%DLL_DT, m%LastTimeCalled ) ) THEN + IF (m%FirstWarn) THEN + IF ( EqualRealNos( p%DT, m%dll_data%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step + CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& + 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& + 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) + ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT + CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& + 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) + END IF + m%FirstWarn = .FALSE. + END IF + ELSE + m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom ! used for linear ramp of delayed signal + m%LastTimeCalled = t + + CALL BladedInterface_CalcOutput( t, u, p, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + m%dll_data%initialized = .true. + END IF + + !END IF + +END SUBROUTINE DLL_controller_call +!---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -932,23 +1041,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ! Get the demanded values from the external Bladed dynamic link library, if necessary: !............................................................................................................................... IF ( p%UseBladedInterface ) THEN - - IF ( .NOT. EqualRealNos( t - p%DLL_DT, m%LastTimeCalled ) ) THEN - IF (m%FirstWarn) THEN - IF ( EqualRealNos( p%DT, p%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step - CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& - 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT - CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - END IF - m%FirstWarn = .FALSE. - END IF - ELSE - m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom ! used for linear ramp of delayed signal - m%LastTimeCalled = t - CALL BladedInterface_CalcOutput( t, u, p, m, ErrStat2, ErrMsg2 ) + + ! Initialize the DLL controller in CalcOutput ONLY if it hasn't already been initialized in SrvD_UpdateStates + IF (.NOT. m%dll_data%initialized) THEN + CALL DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -961,8 +1057,8 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg y%SuperController = m%dll_data%SCoutput END IF - END IF - + END IF + !............................................................................................................................... ! Compute the outputs !............................................................................................................................... @@ -973,7 +1069,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg IF (ErrStat >= AbortErrLev) RETURN ! Pitch control: - CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y%BlPitchCom, y%ElecPwr, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -987,6 +1083,15 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN + + !............................................................................................................................... + ! Calculate all of the available output channels: + !............................................................................................................................... + ! This is overwriting the values if it was called from UpdateStates, but they + ! should be the same and this sets the values if we called the DLL above. + m%dll_data%ElecPwr_prev = y%ElecPwr + m%dll_data%GenTrq_prev = y%GenTrq + !............................................................................................................................... ! Calculate all of the available output channels: !............................................................................................................................... @@ -997,10 +1102,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg AllOuts(HSSBrTqC)= 0.001*y%HSSBrTrqC DO K=1,p%NumBl - AllOuts( BlPitchC(K) ) = y%BlPitchCom(K)*R2D + AllOuts( BlPitchC(K) ) = y%BlPitchCom(K)*R2D AllOuts( BlAirfoilC(K) ) = y%BlAirfoilCom(K) - END DO - + END DO + AllOuts(YawMomCom) = -0.001*y%YawMom AllOuts(NTMD_XQ ) = x%NTMD%tmd_x(1) @@ -1023,6 +1128,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ENDDO ! I - All selected output channels + DO I = 1,p%NumOuts_DLL ! Loop through all DLL logging channels + y%WriteOutput(I+p%NumOuts) = m%dll_data%LogChannels( I ) + ENDDO + RETURN END SUBROUTINE SrvD_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1088,12 +1197,22 @@ SUBROUTINE SrvD_UpdateDiscState( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" + + select case (p%TrimCase) + case (TrimCase_yaw) + xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * sign(p%TrimGain, p%YawNeut + xd%CtrlOffset) + case (TrimCase_torque, TrimCase_pitch) + xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * p%TrimGain +! case default +! xd%CtrlOffset = 0.0_ReKi ! same as initialized value + end select + !xd%BlPitchFilter = p%BlAlpha * xd%BlPitchFilter + (1.0_ReKi - p%BlAlpha) * u%BlPitch !if ( p%PCMode == ControlMode_DLL ) then ! if ( p%DLL_Ramp ) then - ! temp = (t - m%LastTimeCalled) / p%DLL_DT + ! temp = (t - m%LastTimeCalled) / m%dll_data%DLL_DT ! temp = m%dll_data%PrevBlPitch(1:p%NumBl) + & ! temp * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) ! else @@ -1194,9 +1313,8 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! local variables REAL(R8Ki) :: AllOuts(3,1:MaxOutPts) ! All the the available output channels - REAL(R8Ki) :: GenTrq, ElecPwr ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD + REAL(R8Ki) :: GenTrq_du, ElecPwr_du ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD INTEGER(IntKi) :: I ! Generic loop index - INTEGER(IntKi) :: K ! Blade index INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_JacobianPInput' @@ -1234,7 +1352,7 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Note this is similiar to SrvD_CalcOutput if (.not. allocated(dYdu)) then - call allocAry(dYdu, 6+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) + call allocAry(dYdu, SrvD_Indx_Y_WrOutput+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if dYdu = 0.0_R8Ki @@ -1244,10 +1362,10 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !> Compute !> \f$ \frac{\partial Y_{GenTrq}}{\partial u_{HSS\_Spd}} \f$ and !> \f$ \frac{\partial Y_{ElecPwr}}{\partial u_{HSS\_Spd}} \f$ in servodyn::torque_jacobianpinput. - call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - dYdu(Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq - dYdu(Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr + dYdu(SrvD_Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq_du + dYdu(SrvD_Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr_du ! Pitch control: @@ -1255,9 +1373,9 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Yaw control: !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{Yaw}} = -p\%YawSpr \f$ - dYdu(Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput + dYdu(SrvD_Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{YawRate}} = -p\%YawDamp \f$ - dYdu(Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput + dYdu(SrvD_Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput !......................................................................................................................... @@ -1265,16 +1383,16 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !......................................................................................................................... AllOuts = 0.0_R8Ki ! all variables not specified below are zeros (either constant or disabled): - AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(Indx_Y_GenTrq,:) - AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(Indx_Y_ElecPwr,:) - AllOuts(:, YawMomCom) = dYdu(Indx_Y_YawMom,:) + AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_GenTrq,:) + AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_ElecPwr,:) + AllOuts(:, YawMomCom) = -0.001_R8Ki*dYdu(SrvD_Indx_Y_YawMom,:) !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) portion of the jacobian with the proper sign: !............................................................................................................................... DO I = 1,p%NumOuts ! Loop through all selected output channels - dYdu(I+Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) + dYdu(I+SrvD_Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) ENDDO ! I - All selected output channels END IF @@ -1573,21 +1691,21 @@ SUBROUTINE SrvD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_o IF ( PRESENT( y_op ) ) THEN if (.not. allocated(y_op)) then - CALL AllocAry( y_op, 6+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) + CALL AllocAry( y_op, SrvD_Indx_Y_WrOutput+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN end if - do i=1,size(Indx_Y_BlPitchCom) - y_op(Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) + do i=1,size(SrvD_Indx_Y_BlPitchCom) + y_op(SrvD_Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) end do - y_op(Indx_Y_YawMom) = y%YawMom - y_op(Indx_Y_GenTrq) = y%GenTrq - y_op(Indx_Y_ElecPwr) = y%ElecPwr + y_op(SrvD_Indx_Y_YawMom) = y%YawMom + y_op(SrvD_Indx_Y_GenTrq) = y%GenTrq + y_op(SrvD_Indx_Y_ElecPwr) = y%ElecPwr do i=1,p%NumOuts - y_op(i+Indx_Y_WrOutput) = y%WriteOutput(i) - end do + y_op(i+SrvD_Indx_Y_WrOutput) = y%WriteOutput(i) + end do END IF @@ -1615,13 +1733,13 @@ END SUBROUTINE SrvD_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine reads the input file and stores all the data in the SrvD_InputFile structure. !! It does not perform data validation. -SUBROUTINE SrvD_ReadInput( InputFileName, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) +SUBROUTINE SrvD_ReadInput( InitInp, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine REAL(DbKi), INTENT(IN) :: Default_DT !< The default DT (from glue code) - CHARACTER(*), INTENT(IN) :: InputFileName !< Name of the input file CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of all the output files written by this routine. TYPE(SrvD_InputFile), INTENT(OUT) :: InputFileData !< Data stored in the module's input file @@ -1645,7 +1763,7 @@ SUBROUTINE SrvD_ReadInput( InputFileName, InputFileData, Default_DT, OutFileRoot ! get the primary/platform input-file data - CALL ReadPrimaryFile( InputFileName, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadPrimaryFile( InitInp, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF ( UnEcho > 0 ) CLOSE( UnEcho ) @@ -1666,20 +1784,20 @@ END SUBROUTINE SrvD_ReadInput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary ServoDyn input file and places the values it reads in the InputFileData structure. !! It opens and prints to an echo file if requested. -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadPrimaryFile( InitInp, InputFileData, OutFileRoot, UnEc, ErrStat, ErrMsg ) !.................................................................................................................................. IMPLICIT NONE ! Passed variables - INTEGER(IntKi), INTENT(OUT) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + INTEGER(IntKi), INTENT(OUT) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ServoDyn input file + TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ServoDyn input file ! Local variables: REAL(ReKi) :: TmpRAry(2) ! A temporary array to read a table from the input file @@ -1696,14 +1814,13 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat - ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" UnEc = -1 Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + CALL GetPath( InitInp%InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) @@ -1720,7 +1837,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat ! Open the Primary input file. - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL OpenFInpFile ( UnIn, InitInp%InputFile, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -1733,24 +1850,24 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat DO !-------------------------- HEADER --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL ReadStr( UnIn, InitInp%InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- SIMULATION CONTROL -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Echo - Echo input to ".ech". - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) + CALL ReadVar( UnIn, InitInp%InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -1765,11 +1882,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(SrvD_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(SrvD_Ver%Name)//' primary input file "'//TRIM( InitInp%InputFile )//'":' REWIND( UnIn, IOSTAT=ErrStat2 ) IF (ErrStat2 /= 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".' ) + CALL CheckError( ErrID_Fatal, 'Error rewinding file "'//TRIM(InitInp%InputFile)//'".' ) RETURN END IF @@ -1782,427 +1899,430 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat ! DT - Communication interval for controllers (s): - CALL ReadVar( UnIn, InputFile, Line, "DT", "Communication interval for controllers (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, Line, "DT", "Communication interval for controllers (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DT READ( Line, *, IOSTAT=IOS) InputFileData%DT - CALL CheckIOS ( IOS, InputFile, 'DT', NumType, ErrStat2, ErrMsg2 ) + CALL CheckIOS ( IOS, InitInp%InputFile, 'DT', NumType, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2, ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN END IF !---------------------- PITCH CONTROL ------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Pitch Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Pitch Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! PCMode - Pitch control mode (-): - CALL ReadVar( UnIn, InputFile, InputFileData%PCMode, "PCMode", "Pitch control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PCMode, "PCMode", "Pitch control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TPCOn - Time to enable active pitch control [unused when PCMode=0] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TPCOn, "TPCOn", "Time to enable active pitch control (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TPCOn, "TPCOn", "Time to enable active pitch control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TPitManS - Time to start override pitch maneuver for blade (K) and end standard pitch control (s): - CALL ReadAryLines( UnIn, InputFile, InputFileData%TPitManS, SIZE(InputFileData%TPitManS), "TPitManS", & + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%TPitManS, SIZE(InputFileData%TPitManS), "TPitManS", & "Time to start override pitch maneuver for blade K and end standard pitch control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! PitManRat - Pitch rates at which override pitch maneuvers head toward final pitch angles (degrees/s) (read in deg/s and converted to radians/s here): - CALL ReadAryLines( UnIn, InputFile, InputFileData%PitManRat, SIZE(InputFileData%PitManRat), "PitManRat", "Pitch rates at which override pitch maneuvers head toward final pitch angles (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%PitManRat, SIZE(InputFileData%PitManRat), "PitManRat", "Pitch rates at which override pitch maneuvers head toward final pitch angles (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PitManRat = InputFileData%PitManRat*D2R ! BlPitchF - Blade (K) final pitch for pitch maneuvers (deg) (read from file in degrees and converted to radians here): - CALL ReadAryLines( UnIn, InputFile, InputFileData%BlPitchF, SIZE(InputFileData%BlPitchF), "BlPitchF", "Blade K final pitch for pitch maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%BlPitchF, SIZE(InputFileData%BlPitchF), "BlPitchF", "Blade K final pitch for pitch maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%BlPitchF = InputFileData%BlPitchF*D2R + !---------------------- GENERATOR AND TORQUE CONTROL ---------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VSContrl - Variable-speed control mode {0: none, 1: simple VS, 3: user-defined from routine UserVSCont, 4: user-defined from Simulink/LabVIEW} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%VSContrl, "VSContrl", "Variable-speed control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VSContrl, "VSContrl", "Variable-speed control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenModel - Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%GenModel, "GenModel", "Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenModel, "GenModel", "Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenEff - Generator efficiency [ignored by the Thevenin and user-defined generator models] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenEff, "GenEff", "Generator efficiency [ignored by the Thevenin and user-defined generator models] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenEff, "GenEff", "Generator efficiency [ignored by the Thevenin and user-defined generator models] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenEff = InputFileData%GenEff*0.01 ! GenTiStr - Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTiStr, "GenTiStr", "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTiStr, "GenTiStr", "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenTiStp - Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTiStp, "GenTiStp", "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTiStp, "GenTiStp", "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SpdGenOn - Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm) (read in rpm and converted to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%SpdGenOn, "SpdGenOn", "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SpdGenOn, "SpdGenOn", "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SpdGenOn = InputFileData%SpdGenOn*RPM2RPS ! TimGenOn - Time to turn on the generator for a startup [used only when GenTiStr=True] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TimGenOn, "TimGenOn", "Time to turn on the generator for a startup [used only when GenTiStr=True] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TimGenOn, "TimGenOn", "Time to turn on the generator for a startup [used only when GenTiStr=True] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TimGenOf - Time to turn off the generator [used only when GenTiStp=True] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TimGenOf, "TimGenOf", "Time to turn off the generator [used only when GenTiStp=True] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TimGenOf, "TimGenOf", "Time to turn off the generator [used only when GenTiStp=True] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- SIMPLE VARIABLE-SPEED TORQUE CONTROL -------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simple Variable-Speed Torque Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simple Variable-Speed Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VS_RtGnSp - Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm) (read in rpm and converted to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_RtGnSp, "VS_RtGnSp", "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_RtGnSp, "VS_RtGnSp", "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_RtGnSp = InputFileData%VS_RtGnSp*RPM2RPS ! VS_RtTq - Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_RtTq, "VS_RtTq", "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_RtTq, "VS_RtTq", "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VS_Rgn2K - Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2) (read in N-m/rpm^2 and converted to N-m/(rad/s)^2 here: - CALL ReadVar( UnIn, InputFile, InputFileData%VS_Rgn2K, "VS_Rgn2K", "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_Rgn2K, "VS_Rgn2K", "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_Rgn2K = InputFileData%VS_Rgn2K/( RPM2RPS**2 ) ! VS_SlPc - Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_SlPc, "VS_SlPc", "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_SlPc, "VS_SlPc", "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_SlPc = InputFileData%VS_SlPc*.01 !---------------------- SIMPLE INDUCTION GENERATOR ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Simple Induction Generator', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simple Induction Generator', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SIG_SlPc - Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_SlPc, "SIG_SlPc", "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_SlPc, "SIG_SlPc", "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SIG_SlPc = InputFileData%SIG_SlPc*.01 ! SIG_SySp - Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm) (read in rpm and convert to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_SySp, "SIG_SySp", "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_SySp, "SIG_SySp", "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SIG_SySp = InputFileData%SIG_SySp*RPM2RPS ! SIG_RtTq - Rated torque [used only when VSContrl=0 and GenModel=1] (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_RtTq, "SIG_RtTq", "Rated torque [used only when VSContrl=0 and GenModel=1] (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_RtTq, "SIG_RtTq", "Rated torque [used only when VSContrl=0 and GenModel=1] (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SIG_PORt - Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_PORt, "SIG_PORt", "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_PORt, "SIG_PORt", "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- THEVENIN-EQUIVALENT INDUCTION GENERATOR ----------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Thevenin-Equivalent Induction Generator', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Thevenin-Equivalent Induction Generator', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_Freq - Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_Freq, "TEC_Freq", "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_Freq, "TEC_Freq", "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_NPol - Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_NPol, "TEC_NPol", "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_NPol, "TEC_NPol", "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_SRes - Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_SRes, "TEC_SRes", "Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_SRes, "TEC_SRes", "Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_RRes - Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_RRes, "TEC_RRes", "Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_RRes, "TEC_RRes", "Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_VLL - Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_VLL, "TEC_VLL", "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_VLL, "TEC_VLL", "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_SLR - Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_SLR, "TEC_SLR", "Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_SLR, "TEC_SLR", "Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_RLR - Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_RLR, "TEC_RLR", "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_RLR, "TEC_RLR", "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_MR - Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_MR, "TEC_MR", "Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_MR, "TEC_MR", "Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- HIGH-SPEED SHAFT BRAKE ---------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: High-Speed Shaft Brake', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: High-Speed Shaft Brake', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - ! HSSBrMode - HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW, 5: user-defined from Bladed-style DLL} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrMode, "HSSBrMode", "HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-)", ErrStat2, ErrMsg2, UnEc) + ! HSSBrMode - HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-): + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrMode, "HSSBrMode", "HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! THSSBrDp - Time to initiate deployment of the HSS brake (s): - CALL ReadVar( UnIn, InputFile, InputFileData%THSSBrDp, "THSSBrDp", "Time to initiate deployment of the HSS brake (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%THSSBrDp, "THSSBrDp", "Time to initiate deployment of the HSS brake (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! HSSBrDT - Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrDT, "HSSBrDT", "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrDT, "HSSBrDT", "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! HSSBrTqF - Fully deployed HSS-brake torque (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrTqF, "HSSBrTqF", "Fully deployed HSS-brake torque (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrTqF, "HSSBrTqF", "Fully deployed HSS-brake torque (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- YAW CONTROL --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Yaw Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Yaw Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YCMode - Yaw control mode {0: none, 3: user-defined from routine UserYawCont, 4: user-defined from Simulink/LabVIEW} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%YCMode, "YCMode", "Yaw control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YCMode, "YCMode", "Yaw control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TYCOn - Time to enable active yaw control [unused when YCMode=0] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TYCOn, "TYCOn", "Time to enable active yaw control [unused when YCMode=0] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TYCOn, "TYCOn", "Time to enable active yaw control [unused when YCMode=0] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawNeut - Neutral yaw position--yaw spring force is zero at this yaw (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%YawNeut, "YawNeut", "Neutral yaw position--yaw spring force is zero at this yaw (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawNeut, "YawNeut", "Neutral yaw position--yaw spring force is zero at this yaw (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%YawNeut = InputFileData%YawNeut*D2R ! YawSpr - Nacelle-yaw spring constant (N-m/rad): - CALL ReadVar( UnIn, InputFile, InputFileData%YawSpr, "YawSpr", "Nacelle-yaw spring constant (N-m/rad)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawSpr, "YawSpr", "Nacelle-yaw spring constant (N-m/rad)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawDamp - Nacelle-yaw constant (N-m/(rad/s)): - CALL ReadVar( UnIn, InputFile, InputFileData%YawDamp, "YawDamp", "Nacelle-yaw constant (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawDamp, "YawDamp", "Nacelle-yaw constant (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TYawManS - Time to start override yaw maneuver and end standard yaw control (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TYawManS, "TYawManS", "Time to start override yaw maneuver and end standard yaw control (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TYawManS, "TYawManS", "Time to start override yaw maneuver and end standard yaw control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawManRat - Yaw maneuver rate (in absolute value) (deg/s) (read in degrees/second and converted to radians/second here): - CALL ReadVar( UnIn, InputFile, InputFileData%YawManRat, "YawManRat", "Yaw maneuver rate (in absolute value) (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawManRat, "YawManRat", "Yaw maneuver rate (in absolute value) (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%YawManRat = InputFileData%YawManRat*D2R ! NacYawF - Final yaw angle for override yaw maneuvers (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%NacYawF, "NacYawF", "Final yaw angle for override yaw maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NacYawF, "NacYawF", "Final yaw angle for override yaw maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%NacYawF = InputFileData%NacYawF*D2R !---------------------- TUNED MASS DAMPER ---------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Tuned Mass Damper', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Tuned Mass Damper', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! CompNTMD - Compute nacelle tuned mass damper {true/false} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompNTMD, "CompNTMD", "Compute nacelle tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%CompNTMD, "CompNTMD", "Compute nacelle tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! NTMDfile - Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]: - CALL ReadVar( UnIn, InputFile, InputFileData%NTMDfile, "NTMDfile", "Name of the file for nacelle tuned mass dampe [unused when CompNTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NTMDfile, "NTMDfile", "Name of the file for nacelle tuned mass dampe [unused when CompNTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%NTMDfile ) ) InputFileData%NTMDfile = TRIM(PriPath)//TRIM(InputFileData%NTMDfile) ! CompTTMD - Compute tower tuned mass damper {true/false} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompTTMD, "CompTTMD", "Compute tower tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%CompTTMD, "CompTTMD", "Compute tower tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TTMDfile - Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]: - CALL ReadVar( UnIn, InputFile, InputFileData%TTMDfile, "TTMDfile", "Name of the file for tower tuned mass dampe [unused when CompTTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TTMDfile, "TTMDfile", "Name of the file for tower tuned mass dampe [unused when CompTTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%TTMDfile ) ) InputFileData%TTMDfile = TRIM(PriPath)//TRIM(InputFileData%TTMDfile) !---------------------- BLADED INTERFACE ---------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Bladed Interface', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Bladed Interface', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN + InputFileData%UseLegacyInterface = .true. + ! DLL_FileName - Name of the Bladed DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%DLL_FileName ) ) InputFileData%DLL_FileName = TRIM(PriPath)//TRIM(InputFileData%DLL_FileName) ! DLL_InFile - Name of input file used in DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_InFile, "DLL_InFile", "Name of input file used in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_InFile, "DLL_InFile", "Name of input file used in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%DLL_InFile ) ) InputFileData%DLL_InFile = TRIM(PriPath)//TRIM(InputFileData%DLL_InFile) ! DLL_ProcName - Name of procedure to be called in DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_ProcName, "DLL_ProcName", "Name of procedure to be called in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_ProcName, "DLL_ProcName", "Name of procedure to be called in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! DLL_DT - Communication interval for dynamic library (s): InputFileData%DLL_DT = InputFileData%DT - CALL ReadVar( UnIn, InputFile, Line, "DLL_DT", "Communication interval for dynamic library (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, Line, "DLL_DT", "Communication interval for dynamic library (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DLL_DT READ( Line, *, IOSTAT=IOS) InputFileData%DLL_DT - CALL CheckIOS ( IOS, InputFile, 'DLL_DT', NumType, ErrStat2, ErrMsg2 ) + CALL CheckIOS ( IOS, InitInp%InputFile, 'DLL_DT', NumType, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2, ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN END IF ! DLL_Ramp - Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_Ramp, "DLL_Ramp", "Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true]", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_Ramp, "DLL_Ramp", "Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true]", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! BPCutoff - Cuttoff frequency for low-pass filter on blade pitch (Hz): - CALL ReadVar( UnIn, InputFile, InputFileData%BPCutoff, "BPCutoff", "Cuttoff frequency for low-pass filter on blade pitch (Hz)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%BPCutoff, "BPCutoff", "Cuttoff frequency for low-pass filter on blade pitch (Hz)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! NacYaw_North - Reference yaw angle of the nacelle when the upwind end points due North (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%NacYaw_North, "NacYaw_North", "Reference yaw angle of the nacelle when the upwind end points due North (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NacYaw_North, "NacYaw_North", "Reference yaw angle of the nacelle when the upwind end points due North (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%NacYaw_North = InputFileData%NacYaw_North*D2R ! Ptch_Cntrl - Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Cntrl, "Ptch_Cntrl", "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Cntrl, "Ptch_Cntrl", "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Ptch_SetPnt - Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_SetPnt, "Ptch_SetPnt", "Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_SetPnt, "Ptch_SetPnt", "Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_SetPnt = InputFileData%Ptch_SetPnt*D2R ! Ptch_Min - Record 6: Minimum pitch angle [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Min, "Ptch_Min", "Record 6: Minimum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Min, "Ptch_Min", "Record 6: Minimum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_Min = InputFileData%Ptch_Min*D2R ! Ptch_Max - Record 7: Maximum pitch angle [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Max, "Ptch_Max", "Record 7: Maximum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Max, "Ptch_Max", "Record 7: Maximum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_Max = InputFileData%Ptch_Max*D2R ! PtchRate_Min - Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s) (read from file in deg/s and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%PtchRate_Min, "PtchRate_Min", "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PtchRate_Min, "PtchRate_Min", "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PtchRate_Min = InputFileData%PtchRate_Min*D2R ! PtchRate_Max - Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s) (read from file in deg/s and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%PtchRate_Max, "PtchRate_Max", "Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PtchRate_Max, "PtchRate_Max", "Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PtchRate_Max = InputFileData%PtchRate_Max*D2R ! Gain_OM - Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2): - CALL ReadVar( UnIn, InputFile, InputFileData%Gain_OM, "Gain_OM", "Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Gain_OM, "Gain_OM", "Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenSpd_MinOM - Record 17: Minimum generator speed [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_MinOM, "GenSpd_MinOM", "Record 17: Minimum generator speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_MinOM, "GenSpd_MinOM", "Record 17: Minimum generator speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_MinOM = InputFileData%GenSpd_MinOM*RPM2RPS ! GenSpd_MaxOM - Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_MaxOM, "GenSpd_MaxOM", "Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_MaxOM, "GenSpd_MaxOM", "Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM*RPM2RPS ! GenSpd_Dem - Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_Dem, "GenSpd_Dem", "Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_Dem, "GenSpd_Dem", "Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_Dem = InputFileData%GenSpd_Dem*RPM2RPS ! GenTrq_Dem - Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTrq_Dem, "GenTrq_Dem", "Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTrq_Dem, "GenTrq_Dem", "Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenPwr_Dem - Record 13: Demanded power [used only with DLL Interface] (W): - CALL ReadVar( UnIn, InputFile, InputFileData%GenPwr_Dem, "GenPwr_Dem", "Record 13: Demanded power [used only with DLL Interface] (W)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenPwr_Dem, "GenPwr_Dem", "Record 13: Demanded power [used only with DLL Interface] (W)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- BLADED INTERFACE TORQUE-SPEED LOOK-UP TABLE ------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! DLL_NumTrq - Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_NumTrq, "DLL_NumTrq", "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_NumTrq, "DLL_NumTrq", "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2216,17 +2336,17 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat IF ( ErrStat >= AbortErrLev ) RETURN END IF - CALL ReadCom( UnIn, InputFile, 'Table Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Table Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadCom( UnIn, InputFile, 'Table Units: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Table Units: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN DO I=1,InputFileData%DLL_NumTrq - CALL ReadAry( UnIn, InputFile, TmpRAry, 2_IntKi, 'Line'//TRIM(Num2LStr(I)), 'Bladed Interface Torque-Speed Look-Up Table', & + CALL ReadAry( UnIn, InitInp%InputFile, TmpRAry, 2_IntKi, 'Line'//TRIM(Num2LStr(I)), 'Bladed Interface Torque-Speed Look-Up Table', & ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2238,52 +2358,52 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat !---------------------- OUTPUT -------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SumPrint - Print summary data to .sum (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutFile - Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) (-): - CALL ReadVar( UnIn, InputFile, InputFileData%OutFile, "OutFile", "Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFile, "OutFile", "Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! ! OutFileFmt - Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both): - !CALL ReadVar( UnIn, InputFile, InputFileData%OutFileFmt, "OutFileFmt", "Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFileFmt, "OutFileFmt", "Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both)", ErrStat2, ErrMsg2, UnEc) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF ( ErrStat >= AbortErrLev ) RETURN ! TabDelim - Flag to cause tab-delimited text output (delimited by space otherwise) (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutFmt - Format used for module's text tabult output (except time); resulting field should be 10 characters (-): - CALL ReadVar( UnIn, InputFile, InputFileData%OutFmt, "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFmt, "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Tstart - Time to start module's tabular output (seconds): - CALL ReadVar( UnIn, InputFile, InputFileData%Tstart, "Tstart", "Time to start module's tabular output (seconds)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Tstart, "Tstart", "Time to start module's tabular output (seconds)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! ! ! DecFact - Decimation factor for module's tabular output (1=output every step) (-): - !CALL ReadVar( UnIn, InputFile, InputFileData%DecFact, "DecFact", "Decimation factor for module's tabular output (1=output every step) (-)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DecFact, "DecFact", "Decimation factor for module's tabular output (1=output every step) (-)", ErrStat2, ErrMsg2, UnEc) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- OUTLIST -------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + CALL ReadOutputList ( UnIn, InitInp%InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2328,22 +2448,26 @@ END SUBROUTINE CheckError END SUBROUTINE ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the primary input file. -SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) +SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables: TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< All the data in the ServoDyn input file - INTEGER(IntKi), INTENT(IN) :: NumBl !< Number of blades INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: K ! Blade number + INTEGER(IntKi) :: K ! Blade number CHARACTER(*), PARAMETER :: RoutineName = 'ValidatePrimaryData' + INTEGER(IntKi) :: ErrStat2 !< Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = '' CALL Pitch_ValidateData() CALL Yaw_ValidateData() @@ -2374,6 +2498,14 @@ SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if (InputFileData%CompNTMD .or. InputFileData%CompTTMD) & call SetErrStat(ErrID_Fatal,"TMD module is not currently allowed in linearization. CompNTMD and CompTTMD must be FALSE.",ErrStat,ErrMsg,RoutineName) + if (InitInp%TrimCase /= TrimCase_none) then + if (InitInp%TrimCase /= TrimCase_yaw .and. InitInp%TrimCase /= TrimCase_torque .and. InitInp%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,"Invalid value entered for TrimCase.",ErrStat,ErrMsg,RoutineName) + else + if (InitInp%TrimGain <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,"TrimGain must be a positive number.",ErrStat,ErrMsg,RoutineName) + end if + end if + end if @@ -2419,11 +2551,11 @@ SUBROUTINE Pitch_ValidateData( ) ! Make sure the number of blades in the simulation doesn't exceed 3: - IF ( NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) + IF ( InitInp%NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) ! Check the pitch-maneuver start times and rates: - DO K=1,MIN(NumBl,SIZE(InputFileData%TPitManS)) + DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TPitManS)) IF ( InputFileData%TPitManS(K) < 0.0_DbKi ) & CALL SetErrStat( ErrID_Fatal, 'TPitManS('//TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -2496,7 +2628,7 @@ SUBROUTINE TipBrake_ValidateData( ) !IF ( p%TpBrDT < 0.0_DbKi ) CALL ProgAbort ( ' TpBrDT must not be negative.' ) - !DO K=1,MIN(NumBl,SIZE(InputFileData%TTpBrDp)) + !DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TTpBrDp)) ! IF ( InputFileData%TTpBrDp(K) < 0.0_DbKi ) & ! CALL SetErrStat( ErrID_Fatal, 'TTpBrDp(' //TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) ! IF ( InputFileData%TBDepISp(K) < 0.0_DbKi ) & @@ -2604,7 +2736,7 @@ END SUBROUTINE ValidatePrimaryData SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< Data stored in the module's input file + TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file (intent OUT for MOVE_ALLOC) TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< The module's parameter data INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred @@ -2776,9 +2908,10 @@ SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) END IF !............................................. - ! Parameters for file output + ! Parameters for file output (not including Bladed DLL logging outputs) !............................................. p%NumOuts = InputFileData%NumOuts + p%NumOuts_DLL = 0 ! set to zero and overwritten if/when the DLL uses it CALL SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, p%NumBl; sets: p%OutParam. CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2813,21 +2946,13 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ! local variables REAL(ReKi) :: YawPosCom ! Commanded yaw angle from user-defined routines, rad. REAL(ReKi) :: YawRateCom ! Commanded yaw rate from user-defined routines, rad/s. + REAL(ReKi) :: YawPosComInt ! Integrated yaw commanded (from DLL), rad - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - + ! Initialize ErrStat - !................................................................... - ! Calculate standard yaw position and rate commands: - !................................................................... + ErrStat = ErrID_None + ErrMsg = "" - CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrMsg) - !................................................................... ! Override standard yaw control with a linear maneuver if necessary: !................................................................... @@ -2845,10 +2970,27 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg YawRateCom = SIGN( p%YawManRat, p%NacYawF - OtherState%NacYawI ) ! Modify the sign of p%YawManRat based on the direction of the yaw maneuever YawPosCom = OtherState%NacYawI + YawRateCom*( t - p%TYawManS ) - ENDIF + ENDIF - ENDIF - + ELSE + + if (p%YCMode == ControlMode_DLL) then + if (m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE .or. m%dll_data%OverrideYawRateWithTorque) then + + y%YawMom = m%dll_data%YawTorqueDemand + + return + end if + end if + + !................................................................... + ! Calculate standard yaw position and rate commands: + !................................................................... + + YawPosComInt = OtherState%YawPosComInt ! get state value. We don't update the state here. + CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, ErrStat, ErrMsg) + + END IF !................................................................... ! Calculate the yaw moment: !................................................................... @@ -2857,19 +2999,29 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg - p%YawDamp*( u%YawRate - YawRateCom ) ! {-f(qd,q,t)}DampYaw; + !................................................................... + ! Apply trim case for linearization: + ! prescribed yaw will be wrong in this case..... + !................................................................... + if (p%TrimCase==TrimCase_yaw) then + y%YawMom = y%YawMom + xd%CtrlOffset * p%YawSpr + end if + + END SUBROUTINE Yaw_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calculates standard yaw position and rate commands: YawPosCom and YawRateCom. -SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrMsg) - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(ReKi), INTENT( OUT) :: YawPosCom !< Commanded yaw angle from user-defined routines, rad. - REAL(ReKi), INTENT( OUT) :: YawRateCom !< Commanded yaw rate from user-defined routines, rad/s. - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None +SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, ErrStat, ErrMsg) + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables + REAL(ReKi), INTENT( OUT) :: YawPosCom !< Commanded yaw angle from user-defined routines, rad. + REAL(ReKi), INTENT( OUT) :: YawRateCom !< Commanded yaw rate from user-defined routines, rad/s. + REAL(ReKi), INTENT(INOUT) :: YawPosComInt !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ErrStat = ErrID_None ErrMsg = "" @@ -2898,10 +3050,15 @@ SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrM CASE ( ControlMode_DLL ) ! User-defined yaw control from Bladed-style DLL - YawPosCom = u%Yaw + m%dll_data%YawRateCom*p%DT !bjj: was this: LastYawPosCom + YawRateCom*( ZTime - LastTime ) - YawRateCom = m%dll_data%YawRateCom + YawPosComInt = YawPosComInt + m%dll_data%YawRateCom*p%DT ! Integrated yaw position + YawPosCom = YawPosComInt !bjj: was this: LastYawPosCom + YawRateCom*( ZTime - LastTime ) + YawRateCom = m%dll_data%YawRateCom + + if (m%dll_data%OverrideYawRateWithTorque .or. m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE) then + call SetErrStat(ErrID_Fatal, "Unable to calculate yaw rate control because yaw torque control (or override) was requested from DLL.", ErrStat, ErrMsg, "CalculateStandardYaw") + return + end if - END SELECT @@ -2944,7 +3101,7 @@ SUBROUTINE Yaw_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - + !................................................................... ! Determine if override of standard yaw control with a linear maneuver is necessary: !................................................................... @@ -2954,7 +3111,7 @@ SUBROUTINE Yaw_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) IF ( .not. OtherState%BegYawMan ) THEN ! Override yaw maneuver is just beginning (possibly again). - CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrMsg) + CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, OtherState%YawPosComInt, ErrStat, ErrMsg) OtherState%NacYawI = YawPosCom !bjj: was u%Yaw ! Store the initial (current) yaw, at the start of the yaw maneuver YawManRat = SIGN( p%YawManRat, p%NacYawF - OtherState%NacYawI ) ! Modify the sign of YawManRat based on the direction of the yaw maneuever @@ -2963,14 +3120,21 @@ SUBROUTINE Yaw_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) OtherState%BegYawMan = .TRUE. ! Let's remember when we stored this these values ENDIF - + + ELSE + + !................................................................... + ! Update OtherState%YawPosComInt: + !................................................................... + CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, OtherState%YawPosComInt, ErrStat, ErrMsg) + ENDIF END SUBROUTINE Yaw_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing the pitch output: blade pitch commands. This routine is used in both loose and tight coupling. -SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, BlPitchCom, ElecPwr, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -2980,8 +3144,9 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + REAL(ReKi), INTENT(INOUT) :: BlPitchCom(:) !< pitch outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) + REAL(ReKi), INTENT(IN ) :: ElecPwr !< Electrical power (watts) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3015,40 +3180,38 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs CASE ( ControlMode_USER ) ! User-defined from routine PitchCntrl(). - CALL PitchCntrl ( u%BlPitch, y%ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, y%BlPitchCom ) + CALL PitchCntrl ( u%BlPitch, ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, BlPitchCom ) CASE ( ControlMode_EXTERN ) ! User-defined from Simulink or LabVIEW. - y%BlPitchCom = u%ExternalBlPitchCom ! copy entire array + BlPitchCom = u%ExternalBlPitchCom ! copy entire array CASE ( ControlMode_DLL ) ! User-defined pitch control from Bladed-style DLL if (p%DLL_Ramp) then - factor = (t - m%LastTimeCalled) / p%DLL_DT - y%BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & - factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) + factor = (t - m%LastTimeCalled) / m%dll_data%DLL_DT + BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & + factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) else - y%BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) + BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) end if ! update the filter state once per time step IF ( EqualRealNos( t - p%DT, m%LastTimeFiltered ) ) THEN - m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * y%BlPitchCom + m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom m%LastTimeFiltered = t END IF - y%BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * y%BlPitchCom + BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom END SELECT ELSE ! Do not control pitch yet, maintain initial pitch angles. - ! Use the initial blade pitch angles: - y%BlPitchCom = p%BlPitchInit - + BlPitchCom = p%BlPitchInit ENDIF @@ -3064,12 +3227,12 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs IF ( t >= OtherState%TPitManE(K) ) THEN ! Override pitch maneuver has ended, blade is locked at BlPitchF. - y%BlPitchCom(K) = p%BlPitchF(K) + BlPitchCom(K) = p%BlPitchF(K) ELSE - - PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever - y%BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat + + PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever + BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat END IF @@ -3078,9 +3241,17 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ENDDO ! K - blades + !................................................................... + ! Apply trim case for linearization: + !................................................................... + if (p%TrimCase==TrimCase_pitch) then + BlPitchCom = BlPitchCom + xd%CtrlOffset + end if + + END SUBROUTINE Pitch_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. +!> This routine updates the continuous and other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -3105,10 +3276,11 @@ SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg - ! Initialize ErrStat + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" - ErrStat = ErrID_None - ErrMsg = "" !................................................................... ! Override standard pitch control with a linear maneuver if necessary: @@ -3200,15 +3372,15 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) ! Determine which inputs are not valid InvalidOutput(BlAirFlC3) = ( p%NumBl < 3 ) - InvalidOutput(BlPitchC3) = ( p%NumBl < 3 ) - InvalidOutput( NTMD_XQ) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_XQD) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_YQ) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_YQD) = ( .not. p%CompNTMD ) - InvalidOutput( TTMD_XQ) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_XQD) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_YQ) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_YQD) = ( .not. p%CompTTMD ) + InvalidOutput( BlPitchC3) = ( p%NumBl < 3 ) + InvalidOutput( NTMD_XQ) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_XQD) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_YQ) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_YQD) = ( .not. p%CompNTMD ) + InvalidOutput( TTMD_XQ) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_XQD) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_YQ) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_YQD) = ( .not. p%CompTTMD ) !------------------------------------------------------------------------------------------------- @@ -3474,65 +3646,81 @@ SUBROUTINE Torque_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM y%ElecPwr = 0.0_ReKi ENDIF + !................................................................... + ! Apply trim case for linearization: + !................................................................... + if (p%TrimCase == TrimCase_torque) then + y%GenTrq = y%GenTrq + xd%CtrlOffset + end if !................................................................................. - ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: + ! Calculate the magnitude of HSS brake torque from DLL controller !................................................................................. - IF ( (.NOT. EqualRealNos(t, p%THSSBrDp )) .AND. t < p%THSSBrDp ) THEN ! HSS brake not deployed yet. + IF (p%HSSBrMode == ControlMode_DLL) THEN + + y%HSSBrTrqC = m%dll_data%HSSBrTrqDemand - HSSBrFrac = 0.0_ReKi + ELSE + + !................................................................................. + ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: + !................................................................................. + IF ( t <= p%THSSBrDp ) THEN ! HSS brake not deployed yet. - ELSE ! HSS brake deployed. + HSSBrFrac = 0.0_ReKi + ELSE ! HSS brake deployed. - SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? + + SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? - CASE ( ControlMode_NONE) ! None + CASE ( ControlMode_NONE) ! None - HSSBrFrac = 0.0_ReKi + HSSBrFrac = 0.0_ReKi - CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. + CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. - IF ( t < p%THSSBrFl ) THEN ! Linear ramp - HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT - ELSE ! Full braking torque - HSSBrFrac = 1.0 - ENDIF + IF ( t < p%THSSBrFl ) THEN ! Linear ramp + HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT + ELSE ! Full braking torque + HSSBrFrac = 1.0 + ENDIF - CASE ( ControlMode_USER ) ! User-defined HSS brake model. + CASE ( ControlMode_USER ) ! User-defined HSS brake model. - CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) + CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) - IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. - ErrStat = ErrID_Fatal - ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' - RETURN - END IF + IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. + ErrStat = ErrID_Fatal + ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' + RETURN + END IF - CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL + !!!CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL + !!! + !!! HSSBrFrac = 1.0_ReKi ! just a placeholder, since it never reaches this case - HSSBrFrac = m%dll_data%HSSBrFrac - y%HSSBrTrqC = ABS( HSSBrFrac*m%dll_data%HSSBrTrqC ) - RETURN - - CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. + CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. - HSSBrFrac = u%ExternalHSSBrFrac + HSSBrFrac = u%ExternalHSSBrFrac - ENDSELECT + ENDSELECT - HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) + HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) - ENDIF + ENDIF ! Calculate the magnitude of HSS brake torque: - ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive + !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. + y%HSSBrTrqC = HSSBrFrac*p%HSSBrTqF ! Scale the full braking torque by the brake torque fraction (don't worry about the sign here). - !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - y%HSSBrTrqC = ABS( HSSBrFrac*p%HSSBrTqF ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - + END IF + + ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive + y%HSSBrTrqC = ABS(y%HSSBrTrqC) + RETURN END SUBROUTINE Torque_CalcOutput @@ -3624,7 +3812,7 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque + REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque command REAL(ReKi), INTENT( OUT) :: ElecPwr !< electrical power INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3654,118 +3842,117 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) ElecPwr = 0.0_ReKi - ! Are we doing simple variable-speed control, or using a generator model? + ! Are we doing simple variable-speed control, or using a generator model? - SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? + SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? - CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. + CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. - SELECT CASE ( p%GenModel ) ! Which generator model are we using? + SELECT CASE ( p%GenModel ) ! Which generator model are we using? - CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. + CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. - Slip = u%HSS_Spd - p%SIG_SySp + Slip = u%HSS_Spd - p%SIG_SySp - IF ( ABS( Slip ) > p%SIG_POSl ) THEN - GenTrq = SIGN( p%SIG_POTq, Slip ) - ELSE - GenTrq = Slip*p%SIG_Slop - ENDIF + IF ( ABS( Slip ) > p%SIG_POSl ) THEN + GenTrq = SIGN( p%SIG_POTq, Slip ) + ELSE + GenTrq = Slip*p%SIG_Slop + ENDIF - ElecPwr = CalculateElecPwr( GenTrq, u, p ) + ElecPwr = CalculateElecPwr( GenTrq, u, p ) - CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. + CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. - SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp + SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp - GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & - /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) + GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & + /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) - ! trying to refactor so we don't divide by SlipRat, which may be 0 - ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely - S2 = SlipRat**2 + ! trying to refactor so we don't divide by SlipRat, which may be 0 + ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely + S2 = SlipRat**2 - ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 - Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & - -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) - Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) - Current1 = Current2 + Currentm + ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 + Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & + -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) + Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) + Current1 = Current2 + Currentm - PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes - PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes + PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes + PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes - PwrMech = GenTrq*u%HSS_Spd - ElecPwr = PwrMech - PwrLossS - PwrLossR + PwrMech = GenTrq*u%HSS_Spd + ElecPwr = PwrMech - PwrLossS - PwrLossR - CASE ( ControlMode_USER ) ! User-defined generator model. + CASE ( ControlMode_USER ) ! User-defined generator model. - ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) + ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) + CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - END SELECT + END SELECT - CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. + CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. - if ( u%HSS_Spd < 0.0_ReKi) then - if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then - call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& - "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) - return - end if - end if + if ( u%HSS_Spd < 0.0_ReKi) then + if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then + call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& + "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) + return + end if + end if - ! Compute the generator torque, which depends on which region we are in: + ! Compute the generator torque, which depends on which region we are in: - IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant - GenTrq = p%VS_RtTq - ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed - GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) - ELSE ! We are in region 2 1/2 - simple induction generator transition region - GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) - ENDIF + IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant + GenTrq = p%VS_RtTq + ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed + GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) + ELSE ! We are in region 2 1/2 - simple induction generator transition region + GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) + ENDIF - ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. + ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. - ElecPwr = GenTrq*u%HSS_Spd*p%GenEff - !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) + ElecPwr = GenTrq*u%HSS_Spd*p%GenEff + !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) - CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). + CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). - ! CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) + CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL + CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL - ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off + ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off - IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on + IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on - GenTrq = m%dll_data%GenTrq + GenTrq = m%dll_data%GenTrq ElecPwr = CalculateElecPwr( GenTrq, u, p ) - ELSE ! generator is off + ELSE ! generator is off - GenTrq = 0.0_ReKi - ElecPwr = 0.0_ReKi + GenTrq = 0.0_ReKi + ElecPwr = 0.0_ReKi - END IF + END IF - CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. + CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. - GenTrq = u%ExternalGenTrq - ElecPwr = u%ExternalElecPwr + GenTrq = u%ExternalGenTrq + ElecPwr = u%ExternalElecPwr - END SELECT + END SELECT ! Lets turn the generator offline for good if ( GenTiStp = .FALSE. ) .AND. ( ElecPwr <= 0.0 ): @@ -3785,7 +3972,7 @@ FUNCTION CalculateElecPwr( GenTrq, u, p ) TYPE(SrvD_InputType), INTENT(IN) :: u !< Inputs at t TYPE(SrvD_ParameterType), INTENT(IN) :: p !< Parameters -REAL(ReKi) :: CalculateElecPwr !< The result of this function +REAL(ReKi) :: CalculateElecPwr !< The result of this function !! The generator efficiency is either additive for motoring, !! or subtractive for generating power. @@ -3794,12 +3981,12 @@ FUNCTION CalculateElecPwr( GenTrq, u, p ) CalculateElecPwr = GenTrq * u%HSS_Spd * p%GenEff ELSE CalculateElecPwr = GenTrq * u%HSS_Spd / p%GenEff - ENDIF + ENDIF END FUNCTION CalculateElecPwr !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the partials with respect to inputs of the drive-train torque outputs: GenTrq and ElecPwr -SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) +SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -3810,8 +3997,8 @@ SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, Elec TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(R8Ki), INTENT( OUT) :: GenTrq !< partial derivative of generator torque output with respect to HSS_Spd input - REAL(R8Ki), INTENT( OUT) :: ElecPwr !< partial derivative of electrical power output with respect to HSS_Spd input + REAL(R8Ki), INTENT( OUT) :: GenTrq_du !< partial derivative of generator torque output with respect to HSS_Spd input + REAL(R8Ki), INTENT( OUT) :: ElecPwr_du !< partial derivative of electrical power output with respect to HSS_Spd input INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3826,11 +4013,11 @@ SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, Elec !................................................................................. IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - CALL CalculateTorqueJacobian( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) + CALL CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) if (ErrStat >= AbortErrLev) return ELSE ! Generator is off line. - GenTrq = 0.0_R8Ki - ElecPwr = 0.0_R8Ki + GenTrq_du = 0.0_R8Ki + ElecPwr_du = 0.0_R8Ki ENDIF @@ -3865,7 +4052,6 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, REAL(R8Ki) :: Current2_i, Current2_i_du ! Current passing through the rotor (amps) and its derivative w.r.t. u%HSS_Spd REAL(R8Ki) :: GenTrq ! generator torque - REAL(R8Ki) :: PwrMech ! Mechanical power in generator REAL(R8Ki) :: ComDenom, ComDenom_du ! temporary variable (common denominator) REAL(R8Ki) :: PwrLossS_du ! Power loss in the stator (watts) and its derivative w.r.t. u%HSS_Spd @@ -3910,8 +4096,10 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, GenTrq_du = p%SIG_Slop ENDIF - - IF ( GenTrq >= 0.0_ReKi ) THEN + ! Calculate the electrical powerF + ! As generator: ElecPwr = GenTrq * u%HSS_Spd * m%GenEff + ! As motor: ElecPwr = GenTrq * u%HSS_Spd / m%GenEff + IF ( GenTrq >= 0.0_R8Ki ) THEN !ElecPwr = GenTrq * u%HSS_Spd * p%GenEff ElecPwr_du = (GenTrq_du * u%HSS_Spd + GenTrq) * p%GenEff ELSE diff --git a/modules/servodyn/src/ServoDyn_Driver.f90 b/modules/servodyn/src/ServoDyn_Driver.f90 index d09a710eac..7ba7135f3f 100644 --- a/modules/servodyn/src/ServoDyn_Driver.f90 +++ b/modules/servodyn/src/ServoDyn_Driver.f90 @@ -26,7 +26,7 @@ PROGRAM SrvD_Driver IMPLICIT NONE - INTEGER(IntKi), PARAMETER :: NumInp = 1 !< Number of inputs sent to SrvD_UpdateStates + INTEGER(IntKi), PARAMETER :: NumInp = 3 !< Number of inputs sent to SrvD_UpdateStates ! Program variables @@ -51,24 +51,31 @@ PROGRAM SrvD_Driver INTEGER(IntKi) :: n !< Loop counter (for time step) + INTEGER(IntKi) :: j !< Loop counter (for interpolation time history) INTEGER(IntKi) :: ErrStat !< Status of error message CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), allocatable :: dYdu(:,:) INTEGER(IntKi) :: Un - INTEGER(IntKi), parameter :: nMax = 80 + INTEGER(IntKi) :: nMax CHARACTER(1024) :: OutFile - + CHARACTER(20) :: FlagArg !< Flag argument from command line + + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'ServoDyn_driver', '', '' ) !............................................................................................................................... ! Routines called in initialization !............................................................................................................................... + CALL NWTC_Init( ProgNameIN=version%Name ) + ! Populate the InitInData data structure here: + ! Check for command line arguments. InitInData%InputFile = '' !'ServoDyn_input.dat' + CALL CheckArgs( InitInData%InputFile, Flag=FlagArg ) + IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() - CALL CheckArgs( InitInData%InputFile, ErrStat) ! if ErrStat2 /= ErrID_None, we'll ignore and deal with the problem when we try to read the input file CALL GetRoot( InitInData%InputFile, OutFile ) OutFile = trim(OutFile)//'.out' @@ -77,16 +84,37 @@ PROGRAM SrvD_Driver ! Set the driver's request for time interval here: - TimeInterval = 0.25 ! Glue code's request for delta time (likely based on information from other modules) - - + TimeInterval = 0.01 ! s + InitInData%InputFile = 'ServoDyn.dat' + InitInData%RootName = OutFile(1:(len_trim(OutFile)-4)) + InitInData%NumBl = 3 + InitInData%gravity = 9.81 !m/s^2 + InitInData%r_N_O_G = (/ 90.0, 0.0, 0.0 /) ! m, position of nacelle (for NTMD) + InitInData%r_TwrBase = (/ 0.0, 0.0, 0.0 /) ! m, position of tower base (for TTMD) + InitInData%TMax = 10.0 !s + InitInData%AirDens = 1.225 !kg/m^3 + InitInData%AvgWindSpeed = 10.0 !m/s + InitInData%Linearize = .false. + InitInData%NumSC2Ctrl = 0 + InitInData%NumCtrl2SC = 0 + + CALL AllocAry(InitInData%BlPitchInit, InitInData%NumBl, 'BlPitchInit', ErrStat, ErrMsg) + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( ErrMsg ) + END IF + InitInData%BlPitchInit = 5.0*pi/180.0 ! radians + + ! Initialize the module CALL SrvD_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) + IF (ErrStat >= AbortErrLev) call ProgAbort('') END IF + nMax = nint(InitInData%TMax/TimeInterval) + ! Destroy initialization data @@ -94,36 +122,62 @@ PROGRAM SrvD_Driver CALL SrvD_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + Time = 0.0_ReKi + DO j = 1, NumInp + InputTime(j) = Time - j*TimeInterval + END DO + DO j = 2, NumInp + CALL SrvD_CopyInput (u(1), u(j), MESH_NEWCOPY, ErrStat, ErrMsg) + END DO + !............................................................................................................................... ! Check the results of the Jacobian routines !............................................................................................................................... - Time = 0.0_ReKi - + + CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput + + + DO n = 0,nMax ! Modify u for inputs at n (likely from the outputs of another module or a set of test conditions) here: + DO j = NumInp-1, 1, -1 + CALL SrvD_CopyInput (u(j), u(j+1), MESH_UPDATECOPY, ErrStat, ErrMsg) + InputTime(j+1) = InputTime(j) + END DO + InputTime(1) = Time + u(1)%BlPitch = y%BlPitchCom - u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n + !u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n + CALL SrvD_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + ! Calculate outputs at n - + Time = (n+1)*TimeInterval CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) END IF - call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) + !call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) - write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) + !write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) + write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput END DO close (un) - !............................................................................................................................... ! Routine to terminate program execution !............................................................................................................................... diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 188ddfca3c..a157ab73e6 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -29,6 +29,9 @@ typedef ^ InitInputType ReKi AvgWindSpeed - - - "average wind speed for the simu typedef ^ InitInputType ReKi AirDens - - - "air density" kg/m^3 typedef ^ InitInputType IntKi NumSC2Ctrl - - - "number of controller inputs [from supercontroller]" - typedef ^ InitInputType IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - +typedef ^ InitInputType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - +typedef ^ InitInputType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ InitInputType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -118,6 +121,7 @@ typedef ^ SrvD_InputFile ReKi GenPwr_Dem - - - "Record 13: Demanded power [used typedef ^ SrvD_InputFile IntKi DLL_NumTrq - - - "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface]" - typedef ^ SrvD_InputFile ReKi GenSpd_TLU {:} - - "Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface]" rad/s typedef ^ SrvD_InputFile ReKi GenTrq_TLU {:} - - "Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface]" Nm +typedef ^ SrvD_InputFile LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - typedef ^ SrvD_InputFile LOGICAL CompNTMD - - - "Compute nacelle tuned mass damper {true/false}" - typedef ^ SrvD_InputFile CHARACTER(1024) NTMDfile - - - "File for nacelle tuned mass damper (quoted string)" - typedef ^ SrvD_InputFile LOGICAL CompTTMD - - - "Compute tower tuned mass damper {true/false}" - @@ -125,16 +129,75 @@ typedef ^ SrvD_InputFile CHARACTER(1024) TTMDfile - - - "File for tower tuned ma # ..... Data for using Bladed DLLs ....................................................................................................... typedef ^ BladedDLLType SiKi avrSWAP {:} - - "The swap array: used to pass data to and from the DLL controller" "see Bladed DLL documentation" -typedef ^ BladedDLLType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) - from Bladed DLL" - -typedef ^ BladedDLLType ReKi HSSBrTrqC - - - "Braking torque" N-m +typedef ^ BladedDLLType ReKi HSSBrTrqDemand - - - "Demanded braking torque - from Bladed DLL" - typedef ^ BladedDLLType ReKi YawRateCom - - - "Nacelle yaw rate demanded from Bladed DLL" rad/s typedef ^ BladedDLLType ReKi GenTrq - - - "Electrical generator torque from Bladed DLL" N-m -typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" N-m -#typedef ^ BladedDLLType ReKi ElecPwr - - - "Electrical power sent to Bladed DLL" W +typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" - typedef ^ BladedDLLType ReKi BlPitchCom 3 - - "Commanded blade pitch angles" radians typedef ^ BladedDLLType ReKi PrevBlPitch 3 - - "Previously commanded blade pitch angles" radians typedef ^ BladedDLLType ReKi BlAirfoilCom 3 - - "Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables)" - +typedef ^ BladedDLLType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W +typedef ^ BladedDLLType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m typedef ^ BladedDLLType SiKi SCoutput {:} - - "controller output to supercontroller" - +typedef ^ BladedDLLType logical initialized - - - "flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates)" - +typedef ^ BladedDLLType INTEGER NumLogChannels - - - "number of log channels from controller" - +typedef ^ BladedDLLType OutParmType LogChannels_OutParam {:} - - "Names and units (and other characteristics) of logging outputs from DLL" - +typedef ^ BladedDLLType ReKi LogChannels {:} - - "logging outputs from controller" - +typedef ^ BladedDLLType IntKi ErrStat - - - "error message from external controller API" - +typedef ^ BladedDLLType CHARACTER(ErrMsgLen) ErrMsg - - - "error message from external controller API" - +typedef ^ BladedDLLType R8Ki CurrentTime - - - "Current Simulation Time" s +typedef ^ BladedDLLType IntKi SimStatus - - - "simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation)" - +typedef ^ BladedDLLType IntKi ShaftBrakeStatusBinaryFlag - - - "binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST)"- +typedef ^ BladedDLLType LOGICAL HSSBrDeployed - - - "Whether the HSS brake has been deployed" - +typedef ^ BladedDLLType R8Ki TimeHSSBrFullyDeployed - - - "Time at which the controller high-speed shaft is fully deployed" s +typedef ^ BladedDLLType R8Ki TimeHSSBrDeployed - - - "Time at which the controller high-speed shaft is first deployed" s +typedef ^ BladedDLLType LOGICAL OverrideYawRateWithTorque - - - "acts similiar to Yaw_Cntrl" - +typedef ^ BladedDLLType ReKi YawTorqueDemand - - - "Demanded yaw actuator torque (override of yaw rate control)" Nm +## these are INPUTS copied to the DLL: +typedef ^ BladedDLLType ReKi BlPitchInput {:} - - "Input blade pitch angles" radians +typedef ^ BladedDLLType ReKi YawAngleFromNorth - - - "Yaw angle of the nacelle relative to North (see NacYaw_North)" rad +typedef ^ BladedDLLType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s +typedef ^ BladedDLLType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s +typedef ^ BladedDLLType ReKi YawErr - - - "Yaw error" radians +typedef ^ BladedDLLType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s +typedef ^ BladedDLLType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 +typedef ^ BladedDLLType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 +typedef ^ BladedDLLType ReKi LSSTipMys - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMzs - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMza - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians +typedef ^ BladedDLLType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ BladedDLLType ReKi YawRate - - - "Current nacelle yaw rate" rad/s +typedef ^ BladedDLLType ReKi YawBrMyn - - - "Rotating (with nacelle) tower-top / yaw bearing pitch moment" N-m +typedef ^ BladedDLLType ReKi YawBrMzn - - - "Tower-top / yaw bearing yaw moment" N-m +typedef ^ BladedDLLType ReKi NcIMURAxs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W +typedef ^ BladedDLLType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m +typedef ^ BladedDLLType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m +## these are PARAMETERS sent to the DLL (THEIR VALUES SHOULD NOT CHANGE DURING SIMULATION): +typedef ^ BladedDLLType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s +typedef ^ BladedDLLType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - +typedef ^ BladedDLLType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ BladedDLLType ReKi GenTrq_Dem - - - "Demanded generator torque above rated" Nm +typedef ^ BladedDLLType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s +typedef ^ BladedDLLType ReKi Ptch_Max - - - "Maximum pitch angle" rad +typedef ^ BladedDLLType ReKi Ptch_Min - - - "Minimum pitch angle" rad +typedef ^ BladedDLLType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad +typedef ^ BladedDLLType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s +typedef ^ BladedDLLType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s +typedef ^ BladedDLLType ReKi GenPwr_Dem - - - "Demanded power (This is not valid for variable-speed, pitch-regulated controllers.)" W +typedef ^ BladedDLLType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 +typedef ^ BladedDLLType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s +typedef ^ BladedDLLType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s +typedef ^ BladedDLLType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - +typedef ^ BladedDLLType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - +typedef ^ BladedDLLType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s +typedef ^ BladedDLLType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm +typedef ^ BladedDLLType IntKi Yaw_Cntrl - - - "Yaw control: 0 = rate; 1 = torque" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -143,6 +206,7 @@ typedef ^ ContinuousStateType TMD_ContinuousStateType NTMD - - - "TMD module sta typedef ^ ContinuousStateType TMD_ContinuousStateType TTMD - - - "TMD module states - tower" - # Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi CtrlOffset - - - "Controller offset parameter" N-m #typedef ^ DiscreteStateType ReKi BlPitchFilter {:} - - "blade pitch filter" - typedef ^ DiscreteStateType TMD_DiscreteStateType NTMD - - - "TMD module states - nacelle" - typedef ^ DiscreteStateType TMD_DiscreteStateType TTMD - - - "TMD module states - tower" - @@ -161,6 +225,7 @@ typedef ^ OtherStateType DbKi TPitManE {:} - - "Time to end pitch maneuvers for typedef ^ OtherStateType Logical BegYawMan - - - "Whether the yaw maneuver actually began" - typedef ^ OtherStateType ReKi NacYawI - - - "Initial yaw angle at the start of the override yaw maneuver" radians typedef ^ OtherStateType DbKi TYawManE - - - "Time to end override yaw maneuver" s +typedef ^ OtherStateType ReKi YawPosComInt - - - "Internal variable that integrates the commanded yaw rate and passes it to YawPosCom" radians # other states for tip-brake deployment: typedef ^ OtherStateType Logical BegTpBr {:} - - "Whether the tip brakes actually deployed" - typedef ^ OtherStateType DbKi TTpBrDp {:} - - "Times to initiate deployment of tip brakes" s @@ -186,7 +251,6 @@ typedef ^ MiscVarType TMD_MiscVarType TTMD - - - "TMD module misc vars - tower" # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi HSSBrDT - - - "Time it takes for HSS brake to reach full deployment once deployed" seconds -typedef ^ ParameterType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-)" - typedef ^ ParameterType ReKi HSSBrTqF - - - "Fully deployed HSS brake torque" typedef ^ ParameterType ReKi SIG_POSl - - - "Pullout slip" typedef ^ ParameterType ReKi SIG_POTq - - - "Pullout torque" @@ -211,7 +275,6 @@ typedef ^ ParameterType ReKi GenEff - - - "Generator efficiency" typedef ^ ParameterType ReKi BlPitchInit {:} - - "Initial blade pitch angles" radians typedef ^ ParameterType ReKi BlPitchF {:} - - "Final blade pitch" typedef ^ ParameterType ReKi PitManRat {:} - - "Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign)" rad/s -typedef ^ ParameterType ReKi BlAlpha typedef ^ ParameterType ReKi YawManRat - - - "Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign)" rad/s typedef ^ ParameterType ReKi NacYawF - - - "Final yaw angle after override yaw maneuver" typedef ^ ParameterType ReKi SpdGenOn - - - "Generator speed to turn on the generator for a startup" @@ -251,55 +314,46 @@ typedef ^ ParameterType LOGICAL CompNTMD - - - "Compute nacelle tuned mass dampe typedef ^ ParameterType LOGICAL CompTTMD - - - "Compute tower tuned mass damper {true/false}" - # parameters for output typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOuts_DLL - - - "Number of logging channels output from the DLL (set at initialization)" - typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - typedef ^ ParameterType CHARACTER(1) Delim - - - "Column delimiter for output text files" - # parameters for Bladed Interface (dynamic-link library) typedef ^ ParameterType LOGICAL UseBladedInterface - - - "Flag that determines if BladedInterface was used" - +typedef ^ ParameterType LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - +typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - typedef ^ ParameterType LOGICAL DLL_Ramp - - - "determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT)" - -typedef ^ ParameterType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s -typedef ^ ParameterType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - -typedef ^ ParameterType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - -typedef ^ ParameterType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 -typedef ^ ParameterType ReKi GenPwr_Dem - - - "Demanded power" W -typedef ^ ParameterType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s -typedef ^ ParameterType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s -typedef ^ ParameterType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s -typedef ^ ParameterType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s -typedef ^ ParameterType ReKi GenTrq_Dem - - - "Demanded generator torque" Nm -typedef ^ ParameterType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm -typedef ^ ParameterType ReKi Ptch_Max - - - "Maximum pitch angle" rad -typedef ^ ParameterType ReKi Ptch_Min - - - "Minimum pitch angle" rad -typedef ^ ParameterType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad -typedef ^ ParameterType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s -typedef ^ ParameterType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s +typedef ^ ParameterType ReKi BlAlpha - - - "parameter for low-pass filter of blade pitch commands from the controller DLL" - +typedef ^ ParameterType IntKi DLL_n - - - "number of steps between the controller being called and SrvD being called" - +typedef ^ ParameterType IntKi avcOUTNAME_LEN - - - "Length of the avcOUTNAME character array passed to/from the DLL" - typedef ^ ParameterType ReKi NacYaw_North - - - "Reference yaw angle of the nacelle when the upwind end points due North" rad -typedef ^ ParameterType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - -typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - -typedef ^ ParameterType TMD_ParameterType NTMD - - - "TMD module parameters - nacelle" - -typedef ^ ParameterType TMD_ParameterType TTMD - - - "TMD module parameters - tower" - typedef ^ ParameterType ReKi AvgWindSpeed - - - "average wind speed for the simulation" m/s typedef ^ ParameterType ReKi AirDens - - - "air density" kg/m^3 +# parameters for trim-case (linearization): +typedef ^ ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - +typedef ^ ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ ParameterType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" +# parameters for other modules: +typedef ^ ParameterType TMD_ParameterType NTMD - - - "TMD module parameters - nacelle" - +typedef ^ ParameterType TMD_ParameterType TTMD - - - "TMD module parameters - tower" - # ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -#typedef ^ InputType MeshType MeshedInput - - - "Meshed input data" - # Define inputs that are not on this mesh here: -typedef ^ InputType ReKi BlPitch {:} - - "Current blade pitch angles" radians -typedef ^ InputType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ InputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians +typedef ^ InputType ReKi Yaw - - 2pi "Current nacelle yaw" radians typedef ^ InputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s typedef ^ InputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s typedef ^ InputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s typedef ^ InputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ InputType ReKi ExternalYawPosCom - - - "Commanded nacelle yaw position from Simulink or Labview" radians +typedef ^ InputType ReKi ExternalYawPosCom - - 2pi "Commanded nacelle yaw position from Simulink or Labview" radians typedef ^ InputType ReKi ExternalYawRateCom - - - "Commanded nacelle yaw rate from Simulink or Labview" rad/s -typedef ^ InputType ReKi ExternalBlPitchCom {:} - - "Commanded blade pitch from Simulink or LabVIEW" radians +typedef ^ InputType ReKi ExternalBlPitchCom {:} - 2pi "Commanded blade pitch from Simulink or LabVIEW" radians typedef ^ InputType ReKi ExternalGenTrq - - - "Electrical generator torque from Simulink or LabVIEW" N-m typedef ^ InputType ReKi ExternalElecPwr - - - "Electrical power from Simulink or LabVIEW" W typedef ^ InputType ReKi ExternalHSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" - typedef ^ InputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ InputType ReKi YawErr - - - "Yaw error" radians -typedef ^ InputType ReKi WindDir - - - "Wind direction" radians +typedef ^ InputType ReKi YawErr - - 2pi "Yaw error" radians +typedef ^ InputType ReKi WindDir - - 2pi "Wind direction" radians typedef ^ InputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m typedef ^ InputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 typedef ^ InputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 @@ -317,9 +371,7 @@ typedef ^ InputType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angu typedef ^ InputType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 typedef ^ InputType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W typedef ^ InputType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s -typedef ^ InputType ReKi YawAngle - - - "Estimate of yaw (nacelle + platform)" radians -typedef ^ InputType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W -typedef ^ InputType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m +typedef ^ InputType ReKi YawAngle - - 2pi "Estimate of yaw (nacelle + platform)" radians typedef ^ InputType TMD_InputType NTMD - - - "TMD module inputs - nacelle" - typedef ^ InputType TMD_InputType TTMD - - - "TMD module inputs - tower" - typedef ^ InputType SiKi SuperController {:} - - "A swap array: used to pass input data to the DLL controller from the supercontroller" - @@ -329,7 +381,7 @@ typedef ^ InputType SiKi SuperController {:} - - "A swap array: used to pass inp #typedef ^ OutputType MeshType MeshedOutput - - - "Meshed output data" - # Define outputs that are not on this mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitchCom {:} - - "Commanded blade pitch angles" radians +typedef ^ OutputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians typedef ^ OutputType ReKi BlAirfoilCom {:} - - "Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables)" - typedef ^ OutputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m typedef ^ OutputType ReKi GenTrq - - - "Electrical generator torque" N-m diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index e8d7c6e427..0b23dfb3b4 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -49,6 +49,9 @@ MODULE ServoDyn_Types REAL(ReKi) :: AirDens !< air density [kg/m^3] INTEGER(IntKi) :: NumSC2Ctrl !< number of controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -138,6 +141,7 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: DLL_NumTrq !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface] [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface] [Nm] + LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] LOGICAL :: CompNTMD !< Compute nacelle tuned mass damper {true/false} [-] CHARACTER(1024) :: NTMDfile !< File for nacelle tuned mass damper (quoted string) [-] LOGICAL :: CompTTMD !< Compute tower tuned mass damper {true/false} [-] @@ -147,15 +151,73 @@ MODULE ServoDyn_Types ! ========= BladedDLLType ======= TYPE, PUBLIC :: BladedDLLType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: avrSWAP !< The swap array: used to pass data to and from the DLL controller [see Bladed DLL documentation] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) - from Bladed DLL [-] - REAL(ReKi) :: HSSBrTrqC !< Braking torque [N-m] + REAL(ReKi) :: HSSBrTrqDemand !< Demanded braking torque - from Bladed DLL [-] REAL(ReKi) :: YawRateCom !< Nacelle yaw rate demanded from Bladed DLL [rad/s] REAL(ReKi) :: GenTrq !< Electrical generator torque from Bladed DLL [N-m] - INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [N-m] + INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [-] REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< Commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch !< Previously commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] + REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SCoutput !< controller output to supercontroller [-] + LOGICAL :: initialized !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] + INTEGER(IntKi) :: NumLogChannels !< number of log channels from controller [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] + INTEGER(IntKi) :: ErrStat !< error message from external controller API [-] + CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] + REAL(R8Ki) :: CurrentTime !< Current Simulation Time [s] + INTEGER(IntKi) :: SimStatus !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] + INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] + LOGICAL :: HSSBrDeployed !< Whether the HSS brake has been deployed [-] + REAL(R8Ki) :: TimeHSSBrFullyDeployed !< Time at which the controller high-speed shaft is fully deployed [s] + REAL(R8Ki) :: TimeHSSBrDeployed !< Time at which the controller high-speed shaft is first deployed [s] + LOGICAL :: OverrideYawRateWithTorque !< acts similiar to Yaw_Cntrl [-] + REAL(ReKi) :: YawTorqueDemand !< Demanded yaw actuator torque (override of yaw rate control) [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInput !< Input blade pitch angles [radians] + REAL(ReKi) :: YawAngleFromNorth !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] + REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: YawErr !< Yaw error [radians] + REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] + CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque above rated [Nm] + REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] + REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] + REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] + REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] + REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] + REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: GenPwr_Dem !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] + REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] + REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] + INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] + INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] + INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] END TYPE BladedDLLType ! ======================= ! ========= SrvD_ContinuousStateType ======= @@ -167,6 +229,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_DiscreteStateType ======= TYPE, PUBLIC :: SrvD_DiscreteStateType + REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] TYPE(TMD_DiscreteStateType) :: NTMD !< TMD module states - nacelle [-] TYPE(TMD_DiscreteStateType) :: TTMD !< TMD module states - tower [-] END TYPE SrvD_DiscreteStateType @@ -186,6 +249,7 @@ MODULE ServoDyn_Types LOGICAL :: BegYawMan !< Whether the yaw maneuver actually began [-] REAL(ReKi) :: NacYawI !< Initial yaw angle at the start of the override yaw maneuver [radians] REAL(DbKi) :: TYawManE !< Time to end override yaw maneuver [s] + REAL(ReKi) :: YawPosComInt !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom [radians] LOGICAL , DIMENSION(:), ALLOCATABLE :: BegTpBr !< Whether the tip brakes actually deployed [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrDp !< Times to initiate deployment of tip brakes [s] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrFl !< Times at which tip brakes are fully deployed [s] @@ -210,7 +274,6 @@ MODULE ServoDyn_Types TYPE, PUBLIC :: SrvD_ParameterType REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: HSSBrDT !< Time it takes for HSS brake to reach full deployment once deployed [seconds] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-) [-] REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS brake torque [-] REAL(ReKi) :: SIG_POSl !< Pullout slip [-] REAL(ReKi) :: SIG_POTq !< Pullout torque [-] @@ -235,7 +298,6 @@ MODULE ServoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchF !< Final blade pitch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign) [rad/s] - REAL(ReKi) :: BlAlpha REAL(ReKi) :: YawManRat !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] REAL(ReKi) :: NacYawF !< Final yaw angle after override yaw maneuver [-] REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup [-] @@ -274,34 +336,25 @@ MODULE ServoDyn_Types LOGICAL :: CompNTMD !< Compute nacelle tuned mass damper {true/false} [-] LOGICAL :: CompTTMD !< Compute tower tuned mass damper {true/false} [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts_DLL !< Number of logging channels output from the DLL (set at initialization) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] LOGICAL :: UseBladedInterface !< Flag that determines if BladedInterface was used [-] + LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] LOGICAL :: DLL_Ramp !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] - INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] - INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] - REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] - REAL(ReKi) :: GenPwr_Dem !< Demanded power [W] - REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] - REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] - REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] - REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] - REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] - REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] - REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] - REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] - REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: BlAlpha !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] + INTEGER(IntKi) :: DLL_n !< number of steps between the controller being called and SrvD being called [-] + INTEGER(IntKi) :: avcOUTNAME_LEN !< Length of the avcOUTNAME character array passed to/from the DLL [-] REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [rad] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] - TYPE(TMD_ParameterType) :: NTMD !< TMD module parameters - nacelle [-] - TYPE(TMD_ParameterType) :: TTMD !< TMD module parameters - tower [-] REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] REAL(ReKi) :: AirDens !< air density [kg/m^3] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + TYPE(TMD_ParameterType) :: NTMD !< TMD module parameters - nacelle [-] + TYPE(TMD_ParameterType) :: TTMD !< TMD module parameters - tower [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -339,8 +392,6 @@ MODULE ServoDyn_Types REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] REAL(ReKi) :: YawAngle !< Estimate of yaw (nacelle + platform) [radians] - REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] - REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] TYPE(TMD_InputType) :: NTMD !< TMD module inputs - nacelle [-] TYPE(TMD_InputType) :: TTMD !< TMD module inputs - tower [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SuperController !< A swap array: used to pass input data to the DLL controller from the supercontroller [-] @@ -401,6 +452,9 @@ SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%AirDens = SrcInitInputData%AirDens DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%TrimCase = SrcInitInputData%TrimCase + DstInitInputData%TrimGain = SrcInitInputData%TrimGain + DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef END SUBROUTINE SrvD_CopyInitInput SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -469,6 +523,9 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = Re_BufSz + 1 ! AirDens Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! RotSpeedRef IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -496,18 +553,18 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -518,25 +575,37 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchInit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchInit))-1 ) = PACK(InData%BlPitchInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchInit) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_N_O_G))-1 ) = PACK(InData%r_N_O_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_N_O_G) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_TwrBase))-1 ) = PACK(InData%r_TwrBase,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_TwrBase) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%r_N_O_G,1), UBOUND(InData%r_N_O_G,1) + ReKiBuf(Re_Xferred) = InData%r_N_O_G(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%r_TwrBase,1), UBOUND(InData%r_TwrBase,1) + ReKiBuf(Re_Xferred) = InData%r_TwrBase(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeedRef + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackInitInput SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -552,12 +621,6 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -572,18 +635,18 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -597,50 +660,41 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchInit)>0) OutData%BlPitchInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchInit) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) + OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%r_N_O_G,1) i1_u = UBOUND(OutData%r_N_O_G,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_N_O_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_N_O_G))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_N_O_G) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_N_O_G,1), UBOUND(OutData%r_N_O_G,1) + OutData%r_N_O_G(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%r_TwrBase,1) i1_u = UBOUND(OutData%r_TwrBase,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_TwrBase = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_TwrBase))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_TwrBase) - DEALLOCATE(mask1) - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%r_TwrBase,1), UBOUND(OutData%r_TwrBase,1) + OutData%r_TwrBase(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeedRef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackInitInput SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -909,12 +963,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -926,12 +980,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -961,10 +1015,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CouplingScheme - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseHSSBrake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CouplingScheme + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseHSSBrake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -975,12 +1029,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -992,12 +1046,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1009,8 +1063,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1022,8 +1078,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1035,8 +1093,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackInitOutput @@ -1053,12 +1113,6 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1086,19 +1140,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1113,19 +1160,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1167,10 +1207,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%CouplingScheme = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseHSSBrake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%CouplingScheme = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseHSSBrake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseHSSBrake) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1184,19 +1224,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1211,19 +1244,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1238,15 +1264,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1261,15 +1282,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -1284,15 +1300,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackInitOutput @@ -1415,6 +1426,7 @@ SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err END IF DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU ENDIF + DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%CompNTMD = SrcInputFileData%CompNTMD DstInputFileData%NTMDfile = SrcInputFileData%NTMDfile DstInputFileData%CompTTMD = SrcInputFileData%CompTTMD @@ -1559,6 +1571,7 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU END IF + Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface Int_BufSz = Int_BufSz + 1 ! CompNTMD Int_BufSz = Int_BufSz + 1*LEN(InData%NTMDfile) ! NTMDfile Int_BufSz = Int_BufSz + 1 ! CompTTMD @@ -1590,104 +1603,110 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManS))-1 ) = PACK(InData%TPitManS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitManRat))-1 ) = PACK(InData%PitManRat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitManRat) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchF))-1 ) = PACK(InData%BlPitchF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchF) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_PORt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Freq - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TEC_NPol - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PCMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TPCOn + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) + DbKiBuf(Db_Xferred) = InData%TPitManS(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) + ReKiBuf(Re_Xferred) = InData%PitManRat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) + ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%VSContrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenModel + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenEff + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdGenOn + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOf + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Rgn2K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_PORt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Freq + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TEC_NPol + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_VLL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_MR + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HSSBrMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrDp + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%HSSBrDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTqF + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%YCMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYCOn + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawNeut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawDamp + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYawManS + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawManRat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawF + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1698,59 +1717,59 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_ProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DLL_Ramp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BPCutoff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_ProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BPCutoff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1761,8 +1780,10 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenSpd_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenSpd_TLU))-1 ) = PACK(InData%GenSpd_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenSpd_TLU) + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1774,21 +1795,25 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenTrq_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenTrq_TLU))-1 ) = PACK(InData%GenTrq_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenTrq_TLU) + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompNTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%NTMDfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%NTMDfile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompTTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TTMDfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TTMDfile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%NTMDfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%NTMDfile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompTTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TTMDfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TTMDfile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE SrvD_PackInputFile SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1804,12 +1829,6 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1824,131 +1843,116 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TPCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TPCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%TPitManS,1) i1_u = UBOUND(OutData%TPitManS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TPitManS = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManS))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) + OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%PitManRat,1) i1_u = UBOUND(OutData%PitManRat,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PitManRat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitManRat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitManRat) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) + OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%BlPitchF,1) i1_u = UBOUND(OutData%BlPitchF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchF) - DEALLOCATE(mask1) - OutData%VSContrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTiStr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SpdGenOn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TimGenOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_PORt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Freq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_NPol = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TEC_SRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%THSSBrDp = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TYCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawNeut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManS = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawManRat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) + OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%VSContrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) + Int_Xferred = Int_Xferred + 1 + OutData%SpdGenOn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TimGenOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_PORt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Freq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_NPol = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TEC_SRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_VLL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_MR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%THSSBrDp = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrTqF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TYCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawNeut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawDamp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TYawManS = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawManRat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYawF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1962,66 +1966,59 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_ProcName) - OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DLL_DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_Ramp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%BPCutoff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_ProcName) + OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%BPCutoff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2035,15 +2032,10 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenSpd_TLU)>0) OutData%GenSpd_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenSpd_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenSpd_TLU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated Int_Xferred = Int_Xferred + 1 @@ -2058,28 +2050,25 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenTrq_TLU)>0) OutData%GenTrq_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenTrq_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenTrq_TLU) - DEALLOCATE(mask1) - END IF - OutData%CompNTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%NTMDfile) - OutData%NTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompTTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TTMDfile) - OutData%TTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) + Int_Xferred = Int_Xferred + 1 + OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%NTMDfile) + OutData%NTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompTTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompTTMD) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TTMDfile) + OutData%TTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE SrvD_UnPackInputFile SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2109,14 +2098,15 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C END IF DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP ENDIF - DstBladedDLLTypeData%HSSBrFrac = SrcBladedDLLTypeData%HSSBrFrac - DstBladedDLLTypeData%HSSBrTrqC = SrcBladedDLLTypeData%HSSBrTrqC + DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom + DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev + DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev IF (ALLOCATED(SrcBladedDLLTypeData%SCoutput)) THEN i1_l = LBOUND(SrcBladedDLLTypeData%SCoutput,1) i1_u = UBOUND(SrcBladedDLLTypeData%SCoutput,1) @@ -2129,6 +2119,122 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C END IF DstBladedDLLTypeData%SCoutput = SrcBladedDLLTypeData%SCoutput ENDIF + DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized + DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels +IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels_OutParam)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels_OutParam)) THEN + ALLOCATE(DstBladedDLLTypeData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1), UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels,1) + i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels)) THEN + ALLOCATE(DstBladedDLLTypeData%LogChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels +ENDIF + DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat + DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg + DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime + DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus + DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag + DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed + DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed + DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed + DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque + DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand +IF (ALLOCATED(SrcBladedDLLTypeData%BlPitchInput)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%BlPitchInput,1) + i1_u = UBOUND(SrcBladedDLLTypeData%BlPitchInput,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%BlPitchInput)) THEN + ALLOCATE(DstBladedDLLTypeData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput +ENDIF + DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth + DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV + DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd + DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr + DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed + DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp + DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp + DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys + DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs + DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya + DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza + DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa + DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw + DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate + DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn + DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn + DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs + DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys + DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs + DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr + DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa + DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc + DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc + DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT + DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile + DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName + DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem + DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem + DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max + DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min + DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt + DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max + DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min + DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem + DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM + DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM + DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM + DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl + DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq +IF (ALLOCATED(SrcBladedDLLTypeData%GenSpd_TLU)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) + i1_u = UBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenSpd_TLU)) THEN + ALLOCATE(DstBladedDLLTypeData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU +ENDIF +IF (ALLOCATED(SrcBladedDLLTypeData%GenTrq_TLU)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) + i1_u = UBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenTrq_TLU)) THEN + ALLOCATE(DstBladedDLLTypeData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU +ENDIF + DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl END SUBROUTINE SrvD_CopyBladedDLLType SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) @@ -2145,6 +2251,24 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(BladedDLLTypeData%SCoutput)) THEN DEALLOCATE(BladedDLLTypeData%SCoutput) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN +DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%LogChannels)) THEN + DEALLOCATE(BladedDLLTypeData%LogChannels) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%BlPitchInput)) THEN + DEALLOCATE(BladedDLLTypeData%BlPitchInput) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN + DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN + DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) ENDIF END SUBROUTINE SrvD_DestroyBladedDLLType @@ -2188,19 +2312,116 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! avrSWAP upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%avrSWAP) ! avrSWAP END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC + Re_BufSz = Re_BufSz + 1 ! HSSBrTrqDemand Re_BufSz = Re_BufSz + 1 ! YawRateCom Re_BufSz = Re_BufSz + 1 ! GenTrq Int_BufSz = Int_BufSz + 1 ! GenState Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom Re_BufSz = Re_BufSz + SIZE(InData%PrevBlPitch) ! PrevBlPitch Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom + Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev + Re_BufSz = Re_BufSz + 1 ! GenTrq_prev Int_BufSz = Int_BufSz + 1 ! SCoutput allocated yes/no IF ( ALLOCATED(InData%SCoutput) ) THEN Int_BufSz = Int_BufSz + 2*1 ! SCoutput upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%SCoutput) ! SCoutput END IF + Int_BufSz = Int_BufSz + 1 ! initialized + Int_BufSz = Int_BufSz + 1 ! NumLogChannels + Int_BufSz = Int_BufSz + 1 ! LogChannels_OutParam allocated yes/no + IF ( ALLOCATED(InData%LogChannels_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LogChannels_OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! LogChannels_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LogChannels_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LogChannels_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LogChannels_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! LogChannels allocated yes/no + IF ( ALLOCATED(InData%LogChannels) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LogChannels upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%LogChannels) ! LogChannels + END IF + Int_BufSz = Int_BufSz + 1 ! ErrStat + Int_BufSz = Int_BufSz + 1*LEN(InData%ErrMsg) ! ErrMsg + Db_BufSz = Db_BufSz + 1 ! CurrentTime + Int_BufSz = Int_BufSz + 1 ! SimStatus + Int_BufSz = Int_BufSz + 1 ! ShaftBrakeStatusBinaryFlag + Int_BufSz = Int_BufSz + 1 ! HSSBrDeployed + Db_BufSz = Db_BufSz + 1 ! TimeHSSBrFullyDeployed + Db_BufSz = Db_BufSz + 1 ! TimeHSSBrDeployed + Int_BufSz = Int_BufSz + 1 ! OverrideYawRateWithTorque + Re_BufSz = Re_BufSz + 1 ! YawTorqueDemand + Int_BufSz = Int_BufSz + 1 ! BlPitchInput allocated yes/no + IF ( ALLOCATED(InData%BlPitchInput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlPitchInput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInput) ! BlPitchInput + END IF + Re_BufSz = Re_BufSz + 1 ! YawAngleFromNorth + Re_BufSz = Re_BufSz + 1 ! HorWindV + Re_BufSz = Re_BufSz + 1 ! HSS_Spd + Re_BufSz = Re_BufSz + 1 ! YawErr + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Re_BufSz = Re_BufSz + 1 ! YawBrTAxp + Re_BufSz = Re_BufSz + 1 ! YawBrTAyp + Re_BufSz = Re_BufSz + 1 ! LSSTipMys + Re_BufSz = Re_BufSz + 1 ! LSSTipMzs + Re_BufSz = Re_BufSz + 1 ! LSSTipMya + Re_BufSz = Re_BufSz + 1 ! LSSTipMza + Re_BufSz = Re_BufSz + 1 ! LSSTipPxa + Re_BufSz = Re_BufSz + 1 ! Yaw + Re_BufSz = Re_BufSz + 1 ! YawRate + Re_BufSz = Re_BufSz + 1 ! YawBrMyn + Re_BufSz = Re_BufSz + 1 ! YawBrMzn + Re_BufSz = Re_BufSz + 1 ! NcIMURAxs + Re_BufSz = Re_BufSz + 1 ! NcIMURAys + Re_BufSz = Re_BufSz + 1 ! NcIMURAzs + Re_BufSz = Re_BufSz + 1 ! RotPwr + Re_BufSz = Re_BufSz + 1 ! LSSTipMxa + Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc + Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc + Db_BufSz = Db_BufSz + 1 ! DLL_DT + Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem + Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem + Re_BufSz = Re_BufSz + 1 ! Ptch_Max + Re_BufSz = Re_BufSz + 1 ! Ptch_Min + Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt + Re_BufSz = Re_BufSz + 1 ! PtchRate_Max + Re_BufSz = Re_BufSz + 1 ! PtchRate_Min + Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem + Re_BufSz = Re_BufSz + 1 ! Gain_OM + Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM + Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM + Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl + Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq + Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no + IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU + END IF + Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no + IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU + END IF + Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2238,25 +2459,35 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%avrSWAP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%avrSWAP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%avrSWAP))-1 ) = PACK(InData%avrSWAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%avrSWAP) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenState - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PrevBlPitch))-1 ) = PACK(InData%PrevBlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PrevBlPitch) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlAirfoilCom))-1 ) = PACK(InData%BlAirfoilCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlAirfoilCom) + DO i1 = LBOUND(InData%avrSWAP,1), UBOUND(InData%avrSWAP,1) + ReKiBuf(Re_Xferred) = InData%avrSWAP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HSSBrTrqDemand + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenState + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PrevBlPitch,1), UBOUND(InData%PrevBlPitch,1) + ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) + ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%ElecPwr_prev + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_prev + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SCoutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2267,9 +2498,226 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SCoutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SCoutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SCoutput))-1 ) = PACK(InData%SCoutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SCoutput) + DO i1 = LBOUND(InData%SCoutput,1), UBOUND(InData%SCoutput,1) + ReKiBuf(Re_Xferred) = InData%SCoutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLogChannels + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LogChannels_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LogChannels) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LogChannels,1), UBOUND(InData%LogChannels,1) + ReKiBuf(Re_Xferred) = InData%LogChannels(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%ErrStat + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ErrMsg) + IntKiBuf(Int_Xferred) = ICHAR(InData%ErrMsg(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%CurrentTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SimStatus + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ShaftBrakeStatusBinaryFlag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HSSBrDeployed, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeHSSBrFullyDeployed + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeHSSBrDeployed + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OverrideYawRateWithTorque, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawTorqueDemand + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BlPitchInput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlPitchInput,1), UBOUND(InData%BlPitchInput,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawAngleFromNorth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HorWindV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawErr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SrvD_PackBladedDLLType SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2285,12 +2733,6 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2318,82 +2760,305 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) + OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HSSBrTrqDemand = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%BlPitchCom,1) + i1_u = UBOUND(OutData%BlPitchCom,1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%PrevBlPitch,1) + i1_u = UBOUND(OutData%PrevBlPitch,1) + DO i1 = LBOUND(OutData%PrevBlPitch,1), UBOUND(OutData%PrevBlPitch,1) + OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%BlAirfoilCom,1) + i1_u = UBOUND(OutData%BlAirfoilCom,1) + DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) + OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SCoutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SCoutput)) DEALLOCATE(OutData%SCoutput) + ALLOCATE(OutData%SCoutput(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SCoutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%avrSWAP)>0) OutData%avrSWAP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%avrSWAP))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%avrSWAP) - DEALLOCATE(mask1) - END IF - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%SCoutput,1), UBOUND(OutData%SCoutput,1) + OutData%SCoutput(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) + Int_Xferred = Int_Xferred + 1 + OutData%NumLogChannels = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LogChannels_OutParam)) DEALLOCATE(OutData%LogChannels_OutParam) + ALLOCATE(OutData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%PrevBlPitch,1) - i1_u = UBOUND(OutData%PrevBlPitch,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%LogChannels_OutParam,1), UBOUND(OutData%LogChannels_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LogChannels)) DEALLOCATE(OutData%LogChannels) + ALLOCATE(OutData%LogChannels(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%PrevBlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PrevBlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PrevBlPitch) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%LogChannels,1), UBOUND(OutData%LogChannels,1) + OutData%LogChannels(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ErrStat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ErrMsg) + OutData%ErrMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrentTime = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SimStatus = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShaftBrakeStatusBinaryFlag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HSSBrDeployed = TRANSFER(IntKiBuf(Int_Xferred), OutData%HSSBrDeployed) + Int_Xferred = Int_Xferred + 1 + OutData%TimeHSSBrFullyDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%TimeHSSBrDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%OverrideYawRateWithTorque = TRANSFER(IntKiBuf(Int_Xferred), OutData%OverrideYawRateWithTorque) + Int_Xferred = Int_Xferred + 1 + OutData%YawTorqueDemand = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlPitchInput)) DEALLOCATE(OutData%BlPitchInput) + ALLOCATE(OutData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%BlAirfoilCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlAirfoilCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlAirfoilCom) - DEALLOCATE(mask1) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SCoutput not allocated + DO i1 = LBOUND(OutData%BlPitchInput,1), UBOUND(OutData%BlPitchInput,1) + OutData%BlPitchInput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawAngleFromNorth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HorWindV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawErr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%RootMyc,1) + i1_u = UBOUND(OutData%RootMyc,1) + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%RootMxc,1) + i1_u = UBOUND(OutData%RootMxc,1) + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SCoutput)) DEALLOCATE(OutData%SCoutput) - ALLOCATE(OutData%SCoutput(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) + ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SCoutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) + ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%SCoutput)>0) OutData%SCoutput = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SCoutput))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SCoutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF + OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SrvD_UnPackBladedDLLType SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2530,8 +3195,8 @@ SUBROUTINE SrvD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 CALL TMD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2603,12 +3268,6 @@ SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackContState' @@ -2622,8 +3281,8 @@ SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2720,6 +3379,7 @@ SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ! ErrStat = ErrID_None ErrMsg = "" + DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset CALL TMD_CopyDiscState( SrcDiscStateData%NTMD, DstDiscStateData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -2776,6 +3436,7 @@ SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! CtrlOffset ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD @@ -2838,6 +3499,8 @@ SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 + ReKiBuf(Re_Xferred) = InData%CtrlOffset + Re_Xferred = Re_Xferred + 1 CALL TMD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2909,12 +3572,6 @@ SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackDiscState' @@ -2928,6 +3585,8 @@ SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + OutData%CtrlOffset = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3144,8 +3803,8 @@ SUBROUTINE SrvD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 CALL TMD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3217,12 +3876,6 @@ SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackConstrState' @@ -3236,8 +3889,8 @@ SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3374,6 +4027,7 @@ SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE + DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt IF (ALLOCATED(SrcOtherStateData%BegTpBr)) THEN i1_l = LBOUND(SrcOtherStateData%BegTpBr,1) i1_u = UBOUND(SrcOtherStateData%BegTpBr,1) @@ -3504,6 +4158,7 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 1 ! BegYawMan Re_BufSz = Re_BufSz + 1 ! NacYawI Db_BufSz = Db_BufSz + 1 ! TYawManE + Re_BufSz = Re_BufSz + 1 ! YawPosComInt Int_BufSz = Int_BufSz + 1 ! BegTpBr allocated yes/no IF ( ALLOCATED(InData%BegTpBr) ) THEN Int_BufSz = Int_BufSz + 2*1 ! BegTpBr upper/lower bounds for each dimension @@ -3593,8 +4248,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegPitMan,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BegPitMan)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BegPitMan)-1 ) = TRANSFER(PACK( InData%BegPitMan ,.TRUE.), IntKiBuf(1), SIZE(InData%BegPitMan)) - Int_Xferred = Int_Xferred + SIZE(InData%BegPitMan) + DO i1 = LBOUND(InData%BegPitMan,1), UBOUND(InData%BegPitMan,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegPitMan(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3606,8 +4263,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchI))-1 ) = PACK(InData%BlPitchI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchI) + DO i1 = LBOUND(InData%BlPitchI,1), UBOUND(InData%BlPitchI,1) + ReKiBuf(Re_Xferred) = InData%BlPitchI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TPitManE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3619,15 +4278,19 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TPitManE)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManE))-1 ) = PACK(InData%TPitManE,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManE) + DO i1 = LBOUND(InData%TPitManE,1), UBOUND(InData%TPitManE,1) + DbKiBuf(Db_Xferred) = InData%TPitManE(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BegYawMan , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawI - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManE - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegYawMan, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawI + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYawManE + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosComInt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BegTpBr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3638,8 +4301,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegTpBr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BegTpBr)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BegTpBr)-1 ) = TRANSFER(PACK( InData%BegTpBr ,.TRUE.), IntKiBuf(1), SIZE(InData%BegTpBr)) - Int_Xferred = Int_Xferred + SIZE(InData%BegTpBr) + DO i1 = LBOUND(InData%BegTpBr,1), UBOUND(InData%BegTpBr,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegTpBr(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TTpBrDp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3651,8 +4316,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrDp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TTpBrDp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TTpBrDp))-1 ) = PACK(InData%TTpBrDp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TTpBrDp) + DO i1 = LBOUND(InData%TTpBrDp,1), UBOUND(InData%TTpBrDp,1) + DbKiBuf(Db_Xferred) = InData%TTpBrDp(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TTpBrFl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3664,13 +4331,15 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrFl,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TTpBrFl)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TTpBrFl))-1 ) = PACK(InData%TTpBrFl,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TTpBrFl) + DO i1 = LBOUND(InData%TTpBrFl,1), UBOUND(InData%TTpBrFl,1) + DbKiBuf(Db_Xferred) = InData%TTpBrFl(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Off4Good , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenOnLine , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Off4Good, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenOnLine, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL TMD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3742,12 +4411,6 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3775,15 +4438,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BegPitMan)>0) OutData%BegPitMan = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BegPitMan))-1 ), OutData%BegPitMan), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BegPitMan) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BegPitMan,1), UBOUND(OutData%BegPitMan,1) + OutData%BegPitMan(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegPitMan(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchI not allocated Int_Xferred = Int_Xferred + 1 @@ -3798,15 +4456,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchI)>0) OutData%BlPitchI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchI,1), UBOUND(OutData%BlPitchI,1) + OutData%BlPitchI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManE not allocated Int_Xferred = Int_Xferred + 1 @@ -3821,22 +4474,19 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TPitManE)>0) OutData%TPitManE = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManE))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManE) - DEALLOCATE(mask1) - END IF - OutData%BegYawMan = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NacYawI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManE = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%TPitManE,1), UBOUND(OutData%TPitManE,1) + OutData%TPitManE(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%BegYawMan = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegYawMan) + Int_Xferred = Int_Xferred + 1 + OutData%NacYawI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TYawManE = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawPosComInt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegTpBr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3850,15 +4500,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BegTpBr)>0) OutData%BegTpBr = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BegTpBr))-1 ), OutData%BegTpBr), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BegTpBr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BegTpBr,1), UBOUND(OutData%BegTpBr,1) + OutData%BegTpBr(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegTpBr(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrDp not allocated Int_Xferred = Int_Xferred + 1 @@ -3873,15 +4518,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TTpBrDp)>0) OutData%TTpBrDp = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TTpBrDp))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TTpBrDp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TTpBrDp,1), UBOUND(OutData%TTpBrDp,1) + OutData%TTpBrDp(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrFl not allocated Int_Xferred = Int_Xferred + 1 @@ -3896,20 +4536,15 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TTpBrFl)>0) OutData%TTpBrFl = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TTpBrFl))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TTpBrFl) - DEALLOCATE(mask1) - END IF - OutData%Off4Good = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenOnLine = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TTpBrFl,1), UBOUND(OutData%TTpBrFl,1) + OutData%TTpBrFl(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%Off4Good = TRANSFER(IntKiBuf(Int_Xferred), OutData%Off4Good) + Int_Xferred = Int_Xferred + 1 + OutData%GenOnLine = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenOnLine) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4172,8 +4807,8 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeCalled - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeCalled + Db_Xferred = Db_Xferred + 1 CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4202,10 +4837,10 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeFiltered - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeFiltered + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%xd_BlPitchFilter) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4216,8 +4851,10 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BlPitchFilter,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xd_BlPitchFilter)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xd_BlPitchFilter))-1 ) = PACK(InData%xd_BlPitchFilter,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xd_BlPitchFilter) + DO i1 = LBOUND(InData%xd_BlPitchFilter,1), UBOUND(InData%xd_BlPitchFilter,1) + ReKiBuf(Re_Xferred) = InData%xd_BlPitchFilter(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL TMD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4290,12 +4927,6 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4310,8 +4941,8 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastTimeCalled = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTimeCalled = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4352,10 +4983,10 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LastTimeFiltered = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) + Int_Xferred = Int_Xferred + 1 + OutData%LastTimeFiltered = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BlPitchFilter not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4369,15 +5000,10 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xd_BlPitchFilter)>0) OutData%xd_BlPitchFilter = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xd_BlPitchFilter))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xd_BlPitchFilter) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xd_BlPitchFilter,1), UBOUND(OutData%xd_BlPitchFilter,1) + OutData%xd_BlPitchFilter(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4478,7 +5104,6 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ErrMsg = "" DstParamData%DT = SrcParamData%DT DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrFrac = SrcParamData%HSSBrFrac DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF DstParamData%SIG_POSl = SrcParamData%SIG_POSl DstParamData%SIG_POTq = SrcParamData%SIG_POTq @@ -4536,7 +5161,6 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg END IF DstParamData%PitManRat = SrcParamData%PitManRat ENDIF - DstParamData%BlAlpha = SrcParamData%BlAlpha DstParamData%YawManRat = SrcParamData%YawManRat DstParamData%NacYawF = SrcParamData%NacYawF DstParamData%SpdGenOn = SrcParamData%SpdGenOn @@ -4597,6 +5221,7 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%CompNTMD = SrcParamData%CompNTMD DstParamData%CompTTMD = SrcParamData%CompTTMD DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL DstParamData%RootName = SrcParamData%RootName IF (ALLOCATED(SrcParamData%OutParam)) THEN i1_l = LBOUND(SrcParamData%OutParam,1) @@ -4616,56 +5241,24 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF DstParamData%Delim = SrcParamData%Delim DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface + DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%DLL_DT = SrcParamData%DLL_DT - DstParamData%DLL_NumTrq = SrcParamData%DLL_NumTrq - DstParamData%Ptch_Cntrl = SrcParamData%Ptch_Cntrl - DstParamData%Gain_OM = SrcParamData%Gain_OM - DstParamData%GenPwr_Dem = SrcParamData%GenPwr_Dem - DstParamData%GenSpd_Dem = SrcParamData%GenSpd_Dem - DstParamData%GenSpd_MaxOM = SrcParamData%GenSpd_MaxOM - DstParamData%GenSpd_MinOM = SrcParamData%GenSpd_MinOM -IF (ALLOCATED(SrcParamData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcParamData%GenSpd_TLU,1) - i1_u = UBOUND(SrcParamData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstParamData%GenSpd_TLU)) THEN - ALLOCATE(DstParamData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GenSpd_TLU = SrcParamData%GenSpd_TLU -ENDIF - DstParamData%GenTrq_Dem = SrcParamData%GenTrq_Dem -IF (ALLOCATED(SrcParamData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcParamData%GenTrq_TLU,1) - i1_u = UBOUND(SrcParamData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstParamData%GenTrq_TLU)) THEN - ALLOCATE(DstParamData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GenTrq_TLU = SrcParamData%GenTrq_TLU -ENDIF - DstParamData%Ptch_Max = SrcParamData%Ptch_Max - DstParamData%Ptch_Min = SrcParamData%Ptch_Min - DstParamData%Ptch_SetPnt = SrcParamData%Ptch_SetPnt - DstParamData%PtchRate_Max = SrcParamData%PtchRate_Max - DstParamData%PtchRate_Min = SrcParamData%PtchRate_Min + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%DLL_InFile = SrcParamData%DLL_InFile - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef CALL TMD_CopyParam( SrcParamData%NTMD, DstParamData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN CALL TMD_CopyParam( SrcParamData%TTMD, DstParamData%TTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens END SUBROUTINE SrvD_CopyParam SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -4697,12 +5290,6 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%GenSpd_TLU)) THEN - DEALLOCATE(ParamData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(ParamData%GenTrq_TLU)) THEN - DEALLOCATE(ParamData%GenTrq_TLU) ENDIF CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat, ErrMsg ) CALL TMD_DestroyParam( ParamData%NTMD, ErrStat, ErrMsg ) @@ -4746,7 +5333,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = 0 Db_BufSz = Db_BufSz + 1 ! DT Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac Re_BufSz = Re_BufSz + 1 ! HSSBrTqF Re_BufSz = Re_BufSz + 1 ! SIG_POSl Re_BufSz = Re_BufSz + 1 ! SIG_POTq @@ -4783,7 +5369,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! PitManRat upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat END IF - Re_BufSz = Re_BufSz + 1 ! BlAlpha Re_BufSz = Re_BufSz + 1 ! YawManRat Re_BufSz = Re_BufSz + 1 ! NacYawF Re_BufSz = Re_BufSz + 1 ! SpdGenOn @@ -4830,6 +5415,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! CompNTMD Int_BufSz = Int_BufSz + 1 ! CompTTMD Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumOuts_DLL Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no IF ( ALLOCATED(InData%OutParam) ) THEN @@ -4857,33 +5443,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END IF Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim Int_BufSz = Int_BufSz + 1 ! UseBladedInterface - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile + Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4901,6 +5461,16 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! DLL_Ramp + Re_BufSz = Re_BufSz + 1 ! BlAlpha + Int_BufSz = Int_BufSz + 1 ! DLL_n + Int_BufSz = Int_BufSz + 1 ! avcOUTNAME_LEN + Re_BufSz = Re_BufSz + 1 ! NacYaw_North + Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed + Re_BufSz = Re_BufSz + 1 ! AirDens + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! RotSpeedRef Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4935,8 +5505,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4964,54 +5532,52 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_POSl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_POTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_Slop - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_A0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_K2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Re1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_V1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Xe1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenEff - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%HSSBrDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTqF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_POSl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_POTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_Slop + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_A0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_K2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_MR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Re1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_V1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_VLL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Xe1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenEff + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5022,8 +5588,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchInit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchInit))-1 ) = PACK(InData%BlPitchInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchInit) + DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5035,8 +5603,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchF))-1 ) = PACK(InData%BlPitchF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchF) + DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) + ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PitManRat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5048,27 +5618,27 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitManRat,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitManRat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitManRat))-1 ) = PACK(InData%PitManRat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitManRat) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrFl - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) + ReKiBuf(Re_Xferred) = InData%PitManRat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawManRat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdGenOn + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrDp + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrFl + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOf + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TPCOn + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TPitManS) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5079,53 +5649,55 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TPitManS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManS))-1 ) = PACK(InData%TPitManS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManS) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Slope - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_TrGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TpBrDT - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) + DbKiBuf(Db_Xferred) = InData%TPitManS(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%TYawManS + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYCOn + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Slope + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_TrGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HSSBrMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PCMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VSContrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%YCMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Rgn2K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawNeut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawDamp + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TpBrDT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TBDepISp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5136,25 +5708,29 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDepISp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TBDepISp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TBDepISp))-1 ) = PACK(InData%TBDepISp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TBDepISp) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TBDrConN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TBDrConD - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompNTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompTTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%TBDepISp,1), UBOUND(InData%TBDepISp,1) + ReKiBuf(Re_Xferred) = InData%TBDepISp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TBDrConN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TBDrConD + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompTTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts_DLL + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5196,74 +5772,14 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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:Int_Xferred+1-1 ) = TRANSFER( InData%UseBladedInterface , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DLL_Ramp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%GenSpd_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenSpd_TLU))-1 ) = PACK(InData%GenSpd_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenSpd_TLU) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%GenTrq_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenTrq_TLU))-1 ) = PACK(InData%GenTrq_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenTrq_TLU) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5292,6 +5808,26 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BlAlpha + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_n + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%avcOUTNAME_LEN + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeedRef + Re_Xferred = Re_Xferred + 1 CALL TMD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5348,10 +5884,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackParam SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5367,12 +5899,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5387,54 +5913,52 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POSl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_Slop = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_A0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_K2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Re1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_V1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Xe1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrTqF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_POSl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_POTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_Slop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_A0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_K2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_MR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Re1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_V1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_VLL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Xe1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5448,15 +5972,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchInit)>0) OutData%BlPitchInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchInit) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) + OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchF not allocated Int_Xferred = Int_Xferred + 1 @@ -5471,15 +5990,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchF)>0) OutData%BlPitchF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) + OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitManRat not allocated Int_Xferred = Int_Xferred + 1 @@ -5494,34 +6008,27 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PitManRat)>0) OutData%PitManRat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitManRat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitManRat) - DEALLOCATE(mask1) - END IF - OutData%BlAlpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawManRat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdGenOn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%THSSBrDp = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%THSSBrFl = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TPCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) + OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawManRat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYawF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdGenOn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%THSSBrDp = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%THSSBrFl = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TPCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManS not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5535,60 +6042,55 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TPitManS)>0) OutData%TPitManS = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManS))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManS) - DEALLOCATE(mask1) - END IF - OutData%TYawManS = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TYCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Slope = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_TrGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VSContrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%YCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawNeut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TpBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) + OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%TYawManS = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TYCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_Slope = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_TrGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HSSBrMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VSContrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%YCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) + Int_Xferred = Int_Xferred + 1 + OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawNeut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawDamp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TpBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDepISp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5602,32 +6104,29 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TBDepISp)>0) OutData%TBDepISp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TBDepISp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TBDepISp) - DEALLOCATE(mask1) - END IF - OutData%TBDrConN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TBDrConD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompNTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CompTTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%TBDepISp,1), UBOUND(OutData%TBDepISp,1) + OutData%TBDepISp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TBDrConN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TBDrConD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) + Int_Xferred = Int_Xferred + 1 + OutData%CompTTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompTTMD) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts_DLL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5684,94 +6183,14 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseBladedInterface = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_Ramp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gain_OM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenSpd_TLU)>0) OutData%GenSpd_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenSpd_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenSpd_TLU) - DEALLOCATE(mask1) - END IF - OutData%GenTrq_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU 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%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenTrq_TLU)>0) OutData%GenTrq_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenTrq_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenTrq_TLU) - DEALLOCATE(mask1) - END IF - OutData%Ptch_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5812,6 +6231,26 @@ SUBROUTINE SrvD_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) + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%BlAlpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%avcOUTNAME_LEN = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeedRef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5892,10 +6331,6 @@ SUBROUTINE SrvD_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) - OutData%AvgWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackParam SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -5968,8 +6403,6 @@ SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%RotPwr = SrcInputData%RotPwr DstInputData%HorWindV = SrcInputData%HorWindV DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%ElecPwr_prev = SrcInputData%ElecPwr_prev - DstInputData%GenTrq_prev = SrcInputData%GenTrq_prev CALL TMD_CopyInput( SrcInputData%NTMD, DstInputData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -6088,8 +6521,6 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = Re_BufSz + 1 ! RotPwr Re_BufSz = Re_BufSz + 1 ! HorWindV Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev - Re_BufSz = Re_BufSz + 1 ! GenTrq_prev ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD @@ -6167,23 +6598,25 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalYawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalYawRateCom - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalYawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalYawRateCom + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ExternalBlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6194,61 +6627,63 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ExternalBlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ExternalBlPitchCom))-1 ) = PACK(InData%ExternalBlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ExternalBlPitchCom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalGenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalHSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WindDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMyc))-1 ) = PACK(InData%RootMyc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMyc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMxc))-1 ) = PACK(InData%RootMxc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMxc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_prev - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%ExternalBlPitchCom,1), UBOUND(InData%ExternalBlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%ExternalBlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%ExternalGenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalHSSBrFrac + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrAccel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawErr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WindDir + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HorWindV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAngle + Re_Xferred = Re_Xferred + 1 CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6315,8 +6750,10 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackInput @@ -6333,12 +6770,6 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6366,30 +6797,25 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalYawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalYawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlPitchCom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6403,86 +6829,67 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ExternalBlPitchCom)>0) OutData%ExternalBlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ExternalBlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ExternalBlPitchCom) - DEALLOCATE(mask1) - END IF - OutData%ExternalGenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalHSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WindDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ExternalBlPitchCom,1), UBOUND(OutData%ExternalBlPitchCom,1) + OutData%ExternalBlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ExternalGenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalHSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrAccel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawErr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMyc,1) i1_u = UBOUND(OutData%RootMyc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMyc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMyc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMyc) - DEALLOCATE(mask1) - OutData%YawBrTAxp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMxc,1) i1_u = UBOUND(OutData%RootMxc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMxc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMxc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMxc) - DEALLOCATE(mask1) - OutData%LSSTipMxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr_prev = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HorWindV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6576,15 +6983,10 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SuperController.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackInput @@ -6839,8 +7241,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6852,8 +7256,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlAirfoilCom) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6865,17 +7271,19 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAirfoilCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlAirfoilCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlAirfoilCom))-1 ) = PACK(InData%BlAirfoilCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlAirfoilCom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) + ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TBDrCon) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6886,8 +7294,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDrCon,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TBDrCon)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TBDrCon))-1 ) = PACK(InData%TBDrCon,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TBDrCon) + DO i1 = LBOUND(InData%TBDrCon,1), UBOUND(InData%TBDrCon,1) + ReKiBuf(Re_Xferred) = InData%TBDrCon(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL TMD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6955,8 +7365,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackOutput @@ -6973,12 +7385,6 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7006,15 +7412,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated Int_Xferred = Int_Xferred + 1 @@ -7029,15 +7430,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchCom)>0) OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAirfoilCom not allocated Int_Xferred = Int_Xferred + 1 @@ -7052,24 +7448,19 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlAirfoilCom)>0) OutData%BlAirfoilCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlAirfoilCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlAirfoilCom) - DEALLOCATE(mask1) - END IF - OutData%YawMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) + OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDrCon not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7083,15 +7474,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TBDrCon)>0) OutData%TBDrCon = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TBDrCon))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TBDrCon) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TBDrCon,1), UBOUND(OutData%TBDrCon,1) + OutData%TBDrCon(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7186,15 +7572,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SuperController.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackOutput @@ -7273,12 +7654,12 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7291,107 +7672,88 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitch,1))) - ALLOCATE(c1(SIZE(u_out%BlPitch,1))) - b1 = -(u1%BlPitch - u2%BlPitch)/t(2) - u_out%BlPitch = u1%BlPitch + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(u1%Yaw - u2%Yaw)/t(2) - u_out%Yaw = u1%Yaw + b0 * t_out - b0 = -(u1%YawRate - u2%YawRate)/t(2) - u_out%YawRate = u1%YawRate + b0 * t_out - b0 = -(u1%LSS_Spd - u2%LSS_Spd)/t(2) - u_out%LSS_Spd = u1%LSS_Spd + b0 * t_out - b0 = -(u1%HSS_Spd - u2%HSS_Spd)/t(2) - u_out%HSS_Spd = u1%HSS_Spd + b0 * t_out - b0 = -(u1%RotSpeed - u2%RotSpeed)/t(2) - u_out%RotSpeed = u1%RotSpeed + b0 * t_out - b0 = -(u1%ExternalYawPosCom - u2%ExternalYawPosCom)/t(2) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b0 * t_out - b0 = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom)/t(2) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b0 * t_out + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) + b = -(u1%YawRate - u2%YawRate) + u_out%YawRate = u1%YawRate + b * ScaleFactor + b = -(u1%LSS_Spd - u2%LSS_Spd) + u_out%LSS_Spd = u1%LSS_Spd + b * ScaleFactor + b = -(u1%HSS_Spd - u2%HSS_Spd) + u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor + b = -(u1%RotSpeed - u2%RotSpeed) + u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%ExternalBlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%ExternalBlPitchCom,1))) - b1 = -(u1%ExternalBlPitchCom - u2%ExternalBlPitchCom)/t(2) - u_out%ExternalBlPitchCom = u1%ExternalBlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(u1%ExternalGenTrq - u2%ExternalGenTrq)/t(2) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b0 * t_out - b0 = -(u1%ExternalElecPwr - u2%ExternalElecPwr)/t(2) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b0 * t_out - b0 = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac)/t(2) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b0 * t_out - b0 = -(u1%TwrAccel - u2%TwrAccel)/t(2) - u_out%TwrAccel = u1%TwrAccel + b0 * t_out - b0 = -(u1%YawErr - u2%YawErr)/t(2) - u_out%YawErr = u1%YawErr + b0 * t_out - b0 = -(u1%WindDir - u2%WindDir)/t(2) - u_out%WindDir = u1%WindDir + b0 * t_out - ALLOCATE(b1(SIZE(u_out%RootMyc,1))) - ALLOCATE(c1(SIZE(u_out%RootMyc,1))) - b1 = -(u1%RootMyc - u2%RootMyc)/t(2) - u_out%RootMyc = u1%RootMyc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%YawBrTAxp - u2%YawBrTAxp)/t(2) - u_out%YawBrTAxp = u1%YawBrTAxp + b0 * t_out - b0 = -(u1%YawBrTAyp - u2%YawBrTAyp)/t(2) - u_out%YawBrTAyp = u1%YawBrTAyp + b0 * t_out - b0 = -(u1%LSSTipPxa - u2%LSSTipPxa)/t(2) - u_out%LSSTipPxa = u1%LSSTipPxa + b0 * t_out - ALLOCATE(b1(SIZE(u_out%RootMxc,1))) - ALLOCATE(c1(SIZE(u_out%RootMxc,1))) - b1 = -(u1%RootMxc - u2%RootMxc)/t(2) - u_out%RootMxc = u1%RootMxc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%LSSTipMxa - u2%LSSTipMxa)/t(2) - u_out%LSSTipMxa = u1%LSSTipMxa + b0 * t_out - b0 = -(u1%LSSTipMya - u2%LSSTipMya)/t(2) - u_out%LSSTipMya = u1%LSSTipMya + b0 * t_out - b0 = -(u1%LSSTipMza - u2%LSSTipMza)/t(2) - u_out%LSSTipMza = u1%LSSTipMza + b0 * t_out - b0 = -(u1%LSSTipMys - u2%LSSTipMys)/t(2) - u_out%LSSTipMys = u1%LSSTipMys + b0 * t_out - b0 = -(u1%LSSTipMzs - u2%LSSTipMzs)/t(2) - u_out%LSSTipMzs = u1%LSSTipMzs + b0 * t_out - b0 = -(u1%YawBrMyn - u2%YawBrMyn)/t(2) - u_out%YawBrMyn = u1%YawBrMyn + b0 * t_out - b0 = -(u1%YawBrMzn - u2%YawBrMzn)/t(2) - u_out%YawBrMzn = u1%YawBrMzn + b0 * t_out - b0 = -(u1%NcIMURAxs - u2%NcIMURAxs)/t(2) - u_out%NcIMURAxs = u1%NcIMURAxs + b0 * t_out - b0 = -(u1%NcIMURAys - u2%NcIMURAys)/t(2) - u_out%NcIMURAys = u1%NcIMURAys + b0 * t_out - b0 = -(u1%NcIMURAzs - u2%NcIMURAzs)/t(2) - u_out%NcIMURAzs = u1%NcIMURAzs + b0 * t_out - b0 = -(u1%RotPwr - u2%RotPwr)/t(2) - u_out%RotPwr = u1%RotPwr + b0 * t_out - b0 = -(u1%HorWindV - u2%HorWindV)/t(2) - u_out%HorWindV = u1%HorWindV + b0 * t_out - b0 = -(u1%YawAngle - u2%YawAngle)/t(2) - u_out%YawAngle = u1%YawAngle + b0 * t_out - b0 = -(u1%ElecPwr_prev - u2%ElecPwr_prev)/t(2) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b0 * t_out - b0 = -(u1%GenTrq_prev - u2%GenTrq_prev)/t(2) - u_out%GenTrq_prev = u1%GenTrq_prev + b0 * t_out + b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) + u_out%ExternalGenTrq = u1%ExternalGenTrq + b * ScaleFactor + b = -(u1%ExternalElecPwr - u2%ExternalElecPwr) + u_out%ExternalElecPwr = u1%ExternalElecPwr + b * ScaleFactor + b = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor + b = -(u1%TwrAccel - u2%TwrAccel) + u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) + DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) + b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) + u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor + END DO + b = -(u1%YawBrTAxp - u2%YawBrTAxp) + u_out%YawBrTAxp = u1%YawBrTAxp + b * ScaleFactor + b = -(u1%YawBrTAyp - u2%YawBrTAyp) + u_out%YawBrTAyp = u1%YawBrTAyp + b * ScaleFactor + b = -(u1%LSSTipPxa - u2%LSSTipPxa) + u_out%LSSTipPxa = u1%LSSTipPxa + b * ScaleFactor + DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) + b = -(u1%RootMxc(i1) - u2%RootMxc(i1)) + u_out%RootMxc(i1) = u1%RootMxc(i1) + b * ScaleFactor + END DO + b = -(u1%LSSTipMxa - u2%LSSTipMxa) + u_out%LSSTipMxa = u1%LSSTipMxa + b * ScaleFactor + b = -(u1%LSSTipMya - u2%LSSTipMya) + u_out%LSSTipMya = u1%LSSTipMya + b * ScaleFactor + b = -(u1%LSSTipMza - u2%LSSTipMza) + u_out%LSSTipMza = u1%LSSTipMza + b * ScaleFactor + b = -(u1%LSSTipMys - u2%LSSTipMys) + u_out%LSSTipMys = u1%LSSTipMys + b * ScaleFactor + b = -(u1%LSSTipMzs - u2%LSSTipMzs) + u_out%LSSTipMzs = u1%LSSTipMzs + b * ScaleFactor + b = -(u1%YawBrMyn - u2%YawBrMyn) + u_out%YawBrMyn = u1%YawBrMyn + b * ScaleFactor + b = -(u1%YawBrMzn - u2%YawBrMzn) + u_out%YawBrMzn = u1%YawBrMzn + b * ScaleFactor + b = -(u1%NcIMURAxs - u2%NcIMURAxs) + u_out%NcIMURAxs = u1%NcIMURAxs + b * ScaleFactor + b = -(u1%NcIMURAys - u2%NcIMURAys) + u_out%NcIMURAys = u1%NcIMURAys + b * ScaleFactor + b = -(u1%NcIMURAzs - u2%NcIMURAzs) + u_out%NcIMURAzs = u1%NcIMURAzs + b * ScaleFactor + b = -(u1%RotPwr - u2%RotPwr) + u_out%RotPwr = u1%RotPwr + b * ScaleFactor + b = -(u1%HorWindV - u2%HorWindV) + u_out%HorWindV = u1%HorWindV + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) CALL TMD_Input_ExtrapInterp1( u1%NTMD, u2%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp1( u1%TTMD, u2%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%SuperController) .AND. ALLOCATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = -(u1%SuperController - u2%SuperController)/t(2) - u_out%SuperController = u1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = -(u1%SuperController(i1) - u2%SuperController(i1)) + u_out%SuperController(i1) = u1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SrvD_Input_ExtrapInterp1 @@ -7422,13 +7784,14 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7447,143 +7810,115 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitch,1))) - ALLOCATE(c1(SIZE(u_out%BlPitch,1))) - b1 = (t(3)**2*(u1%BlPitch - u2%BlPitch) + t(2)**2*(-u1%BlPitch + u3%BlPitch))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%BlPitch + t(3)*u2%BlPitch - t(2)*u3%BlPitch ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BlPitch = u1%BlPitch + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%Yaw - u2%Yaw) + t(2)**2*(-u1%Yaw + u3%Yaw))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Yaw + t(3)*u2%Yaw - t(2)*u3%Yaw ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Yaw = u1%Yaw + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawRate = u1%YawRate + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSS_Spd = u1%LSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HSS_Spd = u1%HSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotSpeed = u1%RotSpeed + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalYawPosCom - u2%ExternalYawPosCom) + t(2)**2*(-u1%ExternalYawPosCom + u3%ExternalYawPosCom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalYawPosCom + t(3)*u2%ExternalYawPosCom - t(2)*u3%ExternalYawPosCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b0 * t_out + c0 * t_out**2 + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) + b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor + c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor + u_out%YawRate = u1%YawRate + b + c * t_out + b = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) * scaleFactor + u_out%LSS_Spd = u1%LSS_Spd + b + c * t_out + b = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) * scaleFactor + u_out%HSS_Spd = u1%HSS_Spd + b + c * t_out + b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor + c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor + u_out%RotSpeed = u1%RotSpeed + b + c * t_out + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor + u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%ExternalBlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%ExternalBlPitchCom,1))) - b1 = (t(3)**2*(u1%ExternalBlPitchCom - u2%ExternalBlPitchCom) + t(2)**2*(-u1%ExternalBlPitchCom + u3%ExternalBlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%ExternalBlPitchCom + t(3)*u2%ExternalBlPitchCom - t(2)*u3%ExternalBlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalBlPitchCom = u1%ExternalBlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TwrAccel = u1%TwrAccel + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawErr - u2%YawErr) + t(2)**2*(-u1%YawErr + u3%YawErr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawErr + t(3)*u2%YawErr - t(2)*u3%YawErr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawErr = u1%YawErr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%WindDir - u2%WindDir) + t(2)**2*(-u1%WindDir + u3%WindDir))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%WindDir + t(3)*u2%WindDir - t(2)*u3%WindDir ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%WindDir = u1%WindDir + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%RootMyc,1))) - ALLOCATE(c1(SIZE(u_out%RootMyc,1))) - b1 = (t(3)**2*(u1%RootMyc - u2%RootMyc) + t(2)**2*(-u1%RootMyc + u3%RootMyc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RootMyc + t(3)*u2%RootMyc - t(2)*u3%RootMyc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RootMyc = u1%RootMyc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrTAxp = u1%YawBrTAxp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrTAyp = u1%YawBrTAyp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipPxa = u1%LSSTipPxa + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%RootMxc,1))) - ALLOCATE(c1(SIZE(u_out%RootMxc,1))) - b1 = (t(3)**2*(u1%RootMxc - u2%RootMxc) + t(2)**2*(-u1%RootMxc + u3%RootMxc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RootMxc + t(3)*u2%RootMxc - t(2)*u3%RootMxc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RootMxc = u1%RootMxc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMxa = u1%LSSTipMxa + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMya = u1%LSSTipMya + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMza = u1%LSSTipMza + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMys = u1%LSSTipMys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMzs = u1%LSSTipMzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrMyn = u1%YawBrMyn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrMzn = u1%YawBrMzn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAxs = u1%NcIMURAxs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAys = u1%NcIMURAys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAzs = u1%NcIMURAzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotPwr = u1%RotPwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HorWindV = u1%HorWindV + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawAngle - u2%YawAngle) + t(2)**2*(-u1%YawAngle + u3%YawAngle))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawAngle + t(3)*u2%YawAngle - t(2)*u3%YawAngle ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawAngle = u1%YawAngle + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ElecPwr_prev - u2%ElecPwr_prev) + t(2)**2*(-u1%ElecPwr_prev + u3%ElecPwr_prev))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ElecPwr_prev + t(3)*u2%ElecPwr_prev - t(2)*u3%ElecPwr_prev ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%GenTrq_prev - u2%GenTrq_prev) + t(2)**2*(-u1%GenTrq_prev + u3%GenTrq_prev))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%GenTrq_prev + t(3)*u2%GenTrq_prev - t(2)*u3%GenTrq_prev ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%GenTrq_prev = u1%GenTrq_prev + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) * scaleFactor + u_out%ExternalGenTrq = u1%ExternalGenTrq + b + c * t_out + b = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) * scaleFactor + u_out%ExternalElecPwr = u1%ExternalElecPwr + b + c * t_out + b = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) * scaleFactor + u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b + c * t_out + b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor + c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor + u_out%TwrAccel = u1%TwrAccel + b + c * t_out + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) + DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) + b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor + u_out%RootMyc(i1) = u1%RootMyc(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) * scaleFactor + u_out%YawBrTAxp = u1%YawBrTAxp + b + c * t_out + b = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) * scaleFactor + u_out%YawBrTAyp = u1%YawBrTAyp + b + c * t_out + b = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) * scaleFactor + u_out%LSSTipPxa = u1%LSSTipPxa + b + c * t_out + DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) + b = (t(3)**2*(u1%RootMxc(i1) - u2%RootMxc(i1)) + t(2)**2*(-u1%RootMxc(i1) + u3%RootMxc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%RootMxc(i1) + t(3)*u2%RootMxc(i1) - t(2)*u3%RootMxc(i1) ) * scaleFactor + u_out%RootMxc(i1) = u1%RootMxc(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) * scaleFactor + u_out%LSSTipMxa = u1%LSSTipMxa + b + c * t_out + b = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) * scaleFactor + u_out%LSSTipMya = u1%LSSTipMya + b + c * t_out + b = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) * scaleFactor + u_out%LSSTipMza = u1%LSSTipMza + b + c * t_out + b = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) * scaleFactor + u_out%LSSTipMys = u1%LSSTipMys + b + c * t_out + b = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) * scaleFactor + u_out%LSSTipMzs = u1%LSSTipMzs + b + c * t_out + b = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) * scaleFactor + u_out%YawBrMyn = u1%YawBrMyn + b + c * t_out + b = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) * scaleFactor + u_out%YawBrMzn = u1%YawBrMzn + b + c * t_out + b = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) * scaleFactor + u_out%NcIMURAxs = u1%NcIMURAxs + b + c * t_out + b = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) * scaleFactor + u_out%NcIMURAys = u1%NcIMURAys + b + c * t_out + b = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) * scaleFactor + u_out%NcIMURAzs = u1%NcIMURAzs + b + c * t_out + b = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))* scaleFactor + c = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) * scaleFactor + u_out%RotPwr = u1%RotPwr + b + c * t_out + b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor + c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor + u_out%HorWindV = u1%HorWindV + b + c * t_out + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) CALL TMD_Input_ExtrapInterp2( u1%NTMD, u2%NTMD, u3%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp2( u1%TTMD, u2%TTMD, u3%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%SuperController) .AND. ALLOCATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = (t(3)**2*(u1%SuperController - u2%SuperController) + t(2)**2*(-u1%SuperController + u3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SuperController + t(3)*u2%SuperController - t(2)*u3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SuperController = u1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = (t(3)**2*(u1%SuperController(i1) - u2%SuperController(i1)) + t(2)**2*(-u1%SuperController(i1) + u3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%SuperController(i1) + t(3)*u2%SuperController(i1) - t(2)*u3%SuperController(i1) ) * scaleFactor + u_out%SuperController(i1) = u1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SrvD_Input_ExtrapInterp2 @@ -7662,12 +7997,12 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7680,57 +8015,48 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(y_out%BlPitchCom,1))) - b1 = -(y1%BlPitchCom - y2%BlPitchCom)/t(2) - y_out%BlPitchCom = y1%BlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlAirfoilCom,1))) - ALLOCATE(c1(SIZE(y_out%BlAirfoilCom,1))) - b1 = -(y1%BlAirfoilCom - y2%BlAirfoilCom)/t(2) - y_out%BlAirfoilCom = y1%BlAirfoilCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) + b = -(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%YawMom - y2%YawMom)/t(2) - y_out%YawMom = y1%YawMom + b0 * t_out - b0 = -(y1%GenTrq - y2%GenTrq)/t(2) - y_out%GenTrq = y1%GenTrq + b0 * t_out - b0 = -(y1%HSSBrTrqC - y2%HSSBrTrqC)/t(2) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b0 * t_out - b0 = -(y1%ElecPwr - y2%ElecPwr)/t(2) - y_out%ElecPwr = y1%ElecPwr + b0 * t_out + b = -(y1%YawMom - y2%YawMom) + y_out%YawMom = y1%YawMom + b * ScaleFactor + b = -(y1%GenTrq - y2%GenTrq) + y_out%GenTrq = y1%GenTrq + b * ScaleFactor + b = -(y1%HSSBrTrqC - y2%HSSBrTrqC) + y_out%HSSBrTrqC = y1%HSSBrTrqC + b * ScaleFactor + b = -(y1%ElecPwr - y2%ElecPwr) + y_out%ElecPwr = y1%ElecPwr + b * ScaleFactor IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - ALLOCATE(b1(SIZE(y_out%TBDrCon,1))) - ALLOCATE(c1(SIZE(y_out%TBDrCon,1))) - b1 = -(y1%TBDrCon - y2%TBDrCon)/t(2) - y_out%TBDrCon = y1%TBDrCon + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) + b = -(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL TMD_Output_ExtrapInterp1( y1%NTMD, y2%NTMD, tin, y_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Output_ExtrapInterp1( y1%TTMD, y2%TTMD, tin, y_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%SuperController) .AND. ALLOCATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = -(y1%SuperController - y2%SuperController)/t(2) - y_out%SuperController = y1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = -(y1%SuperController(i1) - y2%SuperController(i1)) + y_out%SuperController(i1) = y1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SrvD_Output_ExtrapInterp1 @@ -7761,13 +8087,14 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7786,66 +8113,56 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(y_out%BlPitchCom,1))) - b1 = (t(3)**2*(y1%BlPitchCom - y2%BlPitchCom) + t(2)**2*(-y1%BlPitchCom + y3%BlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlPitchCom + t(3)*y2%BlPitchCom - t(2)*y3%BlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlPitchCom = y1%BlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlAirfoilCom,1))) - ALLOCATE(c1(SIZE(y_out%BlAirfoilCom,1))) - b1 = (t(3)**2*(y1%BlAirfoilCom - y2%BlAirfoilCom) + t(2)**2*(-y1%BlAirfoilCom + y3%BlAirfoilCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlAirfoilCom + t(3)*y2%BlAirfoilCom - t(2)*y3%BlAirfoilCom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlAirfoilCom = y1%BlAirfoilCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) + b = (t(3)**2*(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + t(2)**2*(-y1%BlAirfoilCom(i1) + y3%BlAirfoilCom(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%BlAirfoilCom(i1) + t(3)*y2%BlAirfoilCom(i1) - t(2)*y3%BlAirfoilCom(i1) ) * scaleFactor + y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawMom = y1%YawMom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%GenTrq = y1%GenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%ElecPwr = y1%ElecPwr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor + c = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) * scaleFactor + y_out%YawMom = y1%YawMom + b + c * t_out + b = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))* scaleFactor + c = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) * scaleFactor + y_out%GenTrq = y1%GenTrq + b + c * t_out + b = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))* scaleFactor + c = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) * scaleFactor + y_out%HSSBrTrqC = y1%HSSBrTrqC + b + c * t_out + b = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))* scaleFactor + c = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) * scaleFactor + y_out%ElecPwr = y1%ElecPwr + b + c * t_out IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - ALLOCATE(b1(SIZE(y_out%TBDrCon,1))) - ALLOCATE(c1(SIZE(y_out%TBDrCon,1))) - b1 = (t(3)**2*(y1%TBDrCon - y2%TBDrCon) + t(2)**2*(-y1%TBDrCon + y3%TBDrCon))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%TBDrCon + t(3)*y2%TBDrCon - t(2)*y3%TBDrCon ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TBDrCon = y1%TBDrCon + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) + b = (t(3)**2*(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + t(2)**2*(-y1%TBDrCon(i1) + y3%TBDrCon(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%TBDrCon(i1) + t(3)*y2%TBDrCon(i1) - t(2)*y3%TBDrCon(i1) ) * scaleFactor + y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b + c * t_out + END DO END IF ! check if allocated CALL TMD_Output_ExtrapInterp2( y1%NTMD, y2%NTMD, y3%NTMD, tin, y_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Output_ExtrapInterp2( y1%TTMD, y2%TTMD, y3%TTMD, tin, y_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%SuperController) .AND. ALLOCATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = (t(3)**2*(y1%SuperController - y2%SuperController) + t(2)**2*(-y1%SuperController + y3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%SuperController + t(3)*y2%SuperController - t(2)*y3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SuperController = y1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = (t(3)**2*(y1%SuperController(i1) - y2%SuperController(i1)) + t(2)**2*(-y1%SuperController(i1) + y3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%SuperController(i1) + t(3)*y2%SuperController(i1) - t(2)*y3%SuperController(i1) ) * scaleFactor + y_out%SuperController(i1) = y1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SrvD_Output_ExtrapInterp2 diff --git a/modules/servodyn/src/TMD.f90 b/modules/servodyn/src/TMD.f90 index 0481f691f4..df29a5426d 100644 --- a/modules/servodyn/src/TMD.f90 +++ b/modules/servodyn/src/TMD.f90 @@ -94,7 +94,7 @@ SUBROUTINE TMD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu INTEGER(IntKi) :: UnEcho ! Unit number for the echo file INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(1024) :: ErrMsg2 ! local error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Init' @@ -442,7 +442,7 @@ END SUBROUTINE TMD_UpdateStates !! !! For details, see: !! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." �16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Runge-Kutta." Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: !! Cambridge University Press, pp. 704-716, 1992. SUBROUTINE TMD_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -558,7 +558,7 @@ SUBROUTINE ExitThisRoutine() ! local variables INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) CALL TMD_DestroyContState( xdot, ErrStat3, ErrMsg3 ) diff --git a/modules/servodyn/src/TMD_Registry.txt b/modules/servodyn/src/TMD_Registry.txt index 105c5a0e95..c2d74036c8 100644 --- a/modules/servodyn/src/TMD_Registry.txt +++ b/modules/servodyn/src/TMD_Registry.txt @@ -53,8 +53,8 @@ typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" m/s^2 typedef ^ ^ ReKi r_N_O_G {3} - - "nacelle origin for setting up mesh" - # Define outputs from the initialization routine here: typedef ^ InitOutputType SiKi DummyInitOut - - - "dummy init output" - -#typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -#typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:}- - "Units of the output-to-file channels" - +#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:}- - "Units of the output-to-file channels" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: diff --git a/modules/servodyn/src/TMD_Types.f90 b/modules/servodyn/src/TMD_Types.f90 index a76b12542c..c0ba34ab4c 100644 --- a/modules/servodyn/src/TMD_Types.f90 +++ b/modules/servodyn/src/TMD_Types.f90 @@ -344,78 +344,78 @@ SUBROUTINE TMD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%TMDFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TMDFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_SA_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_X_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_Y_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_XY_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_DWSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_UWSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_PLSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_NLSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%USE_F_TBL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TMD_F_TBL_FILE) - IntKiBuf(Int_Xferred) = ICHAR(InData%TMD_F_TBL_FILE(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%TMDFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%TMDFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TMD_CMODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_SA_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_DOF_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_X_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_Y_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_XY_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_DWSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_UWSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_KS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_CS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_PLSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_NLSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_KS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_CS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_Z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_BRAKE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_BRAKE + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%USE_F_TBL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TMD_F_TBL_FILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%TMD_F_TBL_FILE(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -429,8 +429,12 @@ SUBROUTINE TMD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_TBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_TBL))-1 ) = PACK(InData%F_TBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_TBL) + DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) + DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) + ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_PackInputFile @@ -447,12 +451,6 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -468,78 +466,78 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%TMDFileName) - OutData%TMDFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMD_CMODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_SA_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_DOF_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_Y_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_XY_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_DWSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_UWSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_KS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_CS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_PLSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_NLSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_KS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_CS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_Z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%USE_F_TBL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TMD_F_TBL_FILE) - OutData%TMD_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%TMDFileName) + OutData%TMDFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMD_CMODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_SA_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_DOF_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_X_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_Y_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_XY_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_DWSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_UWSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_KS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_CS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_PLSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_NLSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_KS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_CS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_Z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%USE_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%USE_F_TBL) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TMD_F_TBL_FILE) + OutData%TMD_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -556,15 +554,12 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_TBL)>0) OutData%F_TBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_TBL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_TBL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) + DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) + OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_UnPackInputFile @@ -666,18 +661,20 @@ SUBROUTINE TMD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_N_O_G))-1 ) = PACK(InData%r_N_O_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_N_O_G) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%r_N_O_G,1), UBOUND(InData%r_N_O_G,1) + ReKiBuf(Re_Xferred) = InData%r_N_O_G(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_PackInitInput SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -693,12 +690,6 @@ SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -713,27 +704,22 @@ SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%r_N_O_G,1) i1_u = UBOUND(OutData%r_N_O_G,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_N_O_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_N_O_G))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_N_O_G) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_N_O_G,1), UBOUND(OutData%r_N_O_G,1) + OutData%r_N_O_G(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_UnPackInitInput SUBROUTINE TMD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -827,8 +813,8 @@ SUBROUTINE TMD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInitOut + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackInitOutput SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -844,12 +830,6 @@ SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackInitOutput' @@ -863,8 +843,8 @@ SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInitOut = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackInitOutput SUBROUTINE TMD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -961,10 +941,12 @@ SUBROUTINE TMD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tmd_x))-1 ) = PACK(InData%tmd_x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tmd_x) + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%tmd_x,1), UBOUND(InData%tmd_x,1) + ReKiBuf(Re_Xferred) = InData%tmd_x(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_PackContState SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -980,12 +962,6 @@ SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1000,19 +976,14 @@ SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%tmd_x,1) i1_u = UBOUND(OutData%tmd_x,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tmd_x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tmd_x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tmd_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tmd_x,1), UBOUND(OutData%tmd_x,1) + OutData%tmd_x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_UnPackContState SUBROUTINE TMD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1106,8 +1077,8 @@ SUBROUTINE TMD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackDiscState SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1123,12 +1094,6 @@ SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackDiscState' @@ -1142,8 +1107,8 @@ SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackDiscState SUBROUTINE TMD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1237,8 +1202,8 @@ SUBROUTINE TMD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackConstrState SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1254,12 +1219,6 @@ SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackConstrState' @@ -1273,8 +1232,8 @@ SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackConstrState SUBROUTINE TMD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1368,8 +1327,8 @@ SUBROUTINE TMD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackOtherState SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1385,12 +1344,6 @@ SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackOtherState' @@ -1404,8 +1357,8 @@ SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackOtherState SUBROUTINE TMD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1514,22 +1467,34 @@ SUBROUTINE TMD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_stop))-1 ) = PACK(InData%F_stop,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_stop) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_ext))-1 ) = PACK(InData%F_ext,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_ext) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_fr))-1 ) = PACK(InData%F_fr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_fr) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_ctrl))-1 ) = PACK(InData%C_ctrl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_ctrl) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_Brake))-1 ) = PACK(InData%C_Brake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_Brake) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_table))-1 ) = PACK(InData%F_table,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_table) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%F_k_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%F_k_y - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%F_stop,1), UBOUND(InData%F_stop,1) + ReKiBuf(Re_Xferred) = InData%F_stop(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) + ReKiBuf(Re_Xferred) = InData%F_ext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_fr,1), UBOUND(InData%F_fr,1) + ReKiBuf(Re_Xferred) = InData%F_fr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_ctrl,1), UBOUND(InData%C_ctrl,1) + ReKiBuf(Re_Xferred) = InData%C_ctrl(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_Brake,1), UBOUND(InData%C_Brake,1) + ReKiBuf(Re_Xferred) = InData%C_Brake(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_table,1), UBOUND(InData%F_table,1) + ReKiBuf(Re_Xferred) = InData%F_table(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%F_k_x + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%F_k_y + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackMisc SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1545,12 +1510,6 @@ SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1567,74 +1526,44 @@ SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = 1 i1_l = LBOUND(OutData%F_stop,1) i1_u = UBOUND(OutData%F_stop,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_stop = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_stop))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_stop) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_stop,1), UBOUND(OutData%F_stop,1) + OutData%F_stop(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_ext,1) i1_u = UBOUND(OutData%F_ext,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_ext = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_ext))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_ext) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) + OutData%F_ext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_fr,1) i1_u = UBOUND(OutData%F_fr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_fr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_fr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_fr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_fr,1), UBOUND(OutData%F_fr,1) + OutData%F_fr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_ctrl,1) i1_u = UBOUND(OutData%C_ctrl,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_ctrl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_ctrl))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_ctrl) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_ctrl,1), UBOUND(OutData%C_ctrl,1) + OutData%C_ctrl(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_Brake,1) i1_u = UBOUND(OutData%C_Brake,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_Brake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_Brake))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_Brake) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_Brake,1), UBOUND(OutData%C_Brake,1) + OutData%C_Brake(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_table,1) i1_u = UBOUND(OutData%F_table,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_table = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_table))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_table) - DEALLOCATE(mask1) - OutData%F_k_x = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%F_k_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%F_table,1), UBOUND(OutData%F_table,1) + OutData%F_table(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%F_k_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%F_k_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackMisc SUBROUTINE TMD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1808,66 +1737,76 @@ SUBROUTINE TMD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_X_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_Y_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_XY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%K_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%K_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K_S))-1 ) = PACK(InData%K_S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K_S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_S))-1 ) = PACK(InData%C_S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%P_SP))-1 ) = PACK(InData%P_SP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%P_SP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%N_SP))-1 ) = PACK(InData%N_SP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%N_SP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_ext))-1 ) = PACK(InData%F_ext,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_ext) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_SA_MODE - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Use_F_TBL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TMD_DOF_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_X_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_Y_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Y_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_XY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%K_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%K_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_Y + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%K_S,1), UBOUND(InData%K_S,1) + ReKiBuf(Re_Xferred) = InData%K_S(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_S,1), UBOUND(InData%C_S,1) + ReKiBuf(Re_Xferred) = InData%C_S(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%P_SP,1), UBOUND(InData%P_SP,1) + ReKiBuf(Re_Xferred) = InData%P_SP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%N_SP,1), UBOUND(InData%N_SP,1) + ReKiBuf(Re_Xferred) = InData%N_SP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) + ReKiBuf(Re_Xferred) = InData%F_ext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_CMODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_SA_MODE + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_BRAKE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_BRAKE + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_F_TBL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1881,8 +1820,12 @@ SUBROUTINE TMD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_TBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_TBL))-1 ) = PACK(InData%F_TBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_TBL) + DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) + DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) + ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_PackParam @@ -1899,12 +1842,6 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1920,111 +1857,86 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMD_DOF_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_Y_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%X_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Y_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_XY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%K_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%K_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMD_DOF_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_X_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_Y_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%X_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Y_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_XY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%K_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%K_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%K_S,1) i1_u = UBOUND(OutData%K_S,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%K_S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K_S))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K_S) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%K_S,1), UBOUND(OutData%K_S,1) + OutData%K_S(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_S,1) i1_u = UBOUND(OutData%C_S,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_S))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_S) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_S,1), UBOUND(OutData%C_S,1) + OutData%C_S(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%P_SP,1) i1_u = UBOUND(OutData%P_SP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%P_SP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%P_SP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%P_SP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%P_SP,1), UBOUND(OutData%P_SP,1) + OutData%P_SP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%N_SP,1) i1_u = UBOUND(OutData%N_SP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%N_SP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%N_SP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%N_SP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%N_SP,1), UBOUND(OutData%N_SP,1) + OutData%N_SP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_ext,1) i1_u = UBOUND(OutData%F_ext,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_ext = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_ext))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_ext) - DEALLOCATE(mask1) - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_CMODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_SA_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Use_F_TBL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) + OutData%F_ext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_CMODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_SA_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Use_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_F_TBL) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2041,15 +1953,12 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_TBL)>0) OutData%F_TBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_TBL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_TBL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) + DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) + OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_UnPackParam @@ -2207,12 +2116,6 @@ SUBROUTINE TMD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackInput' @@ -2422,12 +2325,6 @@ SUBROUTINE TMD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackOutput' @@ -2558,8 +2455,8 @@ SUBROUTINE TMD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2574,6 +2471,8 @@ SUBROUTINE TMD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Input_ExtrapInterp1 @@ -2605,8 +2504,9 @@ SUBROUTINE TMD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Input_ExtrapInterp2' @@ -2628,6 +2528,8 @@ SUBROUTINE TMD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Input_ExtrapInterp2 @@ -2707,8 +2609,8 @@ SUBROUTINE TMD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2723,6 +2625,8 @@ SUBROUTINE TMD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Output_ExtrapInterp1 @@ -2754,8 +2658,9 @@ SUBROUTINE TMD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Output_ExtrapInterp2' @@ -2777,6 +2682,8 @@ SUBROUTINE TMD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Output_ExtrapInterp2 diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 2b1efd98c7..dd59ec1477 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -217,7 +217,9 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) REAL(ReKi) :: x1, y1, z1, x2, y2, z2, dx, dy, dz, dd, dt, d1, d2, t1, t2 LOGICAL :: found, CreateNewProp INTEGER(IntKi) :: ErrStat2 - CHARACTER(1024) :: ErrMsg2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None ErrMsg = "" @@ -528,7 +530,8 @@ SUBROUTINE AssembleKM(Init,p, ErrStat, ErrMsg) INTEGER, DIMENSION(NNE) :: nn ! node number in element INTEGER :: r INTEGER(IntKi) :: ErrStat2 - CHARACTER(1024) :: ErrMsg2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + ! for current application if (Init%FEMMod == 2) THEN ! tapered Euler-Bernoulli diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 6a69368f23..e93577dff6 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -712,7 +712,6 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) ! local variable for input and output CHARACTER(1024) :: PriPath ! The path to the primary input file CHARACTER(1024) :: Line ! String to temporarially hold value of read line -INTEGER :: Sttus LOGICAL :: Echo INTEGER(IntKi) :: UnIn @@ -1356,7 +1355,9 @@ SUBROUTINE SD_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg SUBROUTINE CleanUp() INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + CALL SD_DestroyContState( xdot, ErrStat3, ErrMsg3 ) CALL SD_DestroyContState( k1, ErrStat3, ErrMsg3 ) CALL SD_DestroyContState( k2, ErrStat3, ErrMsg3 ) @@ -2016,7 +2017,7 @@ SUBROUTINE ReduceKMdofs(Kred,K,TDOF, Init,p, ErrStat, ErrMsg ) INTEGER :: NReactDOFs INTEGER :: DOF_reduced INTEGER :: ErrStat2 - CHARACTER(1024) :: ErrMsg2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None ErrMsg = '' diff --git a/modules/subdyn/src/SubDyn_Driver.f90 b/modules/subdyn/src/SubDyn_Driver.f90 index 717f5b5f60..eaa18c094b 100644 --- a/modules/subdyn/src/SubDyn_Driver.f90 +++ b/modules/subdyn/src/SubDyn_Driver.f90 @@ -113,11 +113,11 @@ PROGRAM TestSubDyn CALL NWTC_Init( ) ! Display the copyright notice - CALL DispCopyrightLicense( version ) + CALL DispCopyrightLicense( version%Name ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running - CALL WrScr( ' Running '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) + CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) diff --git a/modules/subdyn/src/SubDyn_Output.f90 b/modules/subdyn/src/SubDyn_Output.f90 index 07b7d3a190..cbd2913c47 100644 --- a/modules/subdyn/src/SubDyn_Output.f90 +++ b/modules/subdyn/src/SubDyn_Output.f90 @@ -28,6 +28,7 @@ MODULE SubDyn_Output ! The maximum number of output channels which can be output by the code. INTEGER(IntKi),PUBLIC, PARAMETER :: MaxOutPts = 2265 + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 PRIVATE @@ -2771,7 +2772,7 @@ MODULE SubDyn_Output - CHARACTER(10), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "INTFFXSS ","INTFFYSS ","INTFFZSS ","INTFMXSS ","INTFMYSS ","INTFMZSS ","INTFRAXSS", & "INTFRAYSS","INTFRAZSS","INTFRDXSS","INTFRDYSS","INTFRDZSS","INTFTAXSS","INTFTAYSS", & "INTFTAZSS","INTFTDXSS","INTFTDYSS","INTFTDZSS","M1N1FKXE ","M1N1FKYE ","M1N1FKZE ", & diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index b69c6c3c8a..248ce4ba22 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -18,8 +18,8 @@ typedef ^ InitInputType ReKi TP_RefPoint {3} - - "global position of transitio typedef ^ InitInputType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" # ============================== Define Initialization outputs here: ============================================================================================================================================ -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - # ============================== Define Internal data types here: ============================================================================================================================================ @@ -87,7 +87,7 @@ typedef ^ ^ ReKi CMass {:}{:} - - "Concentrated mass information" typedef ^ ^ ReKi JDampings {:} - - "Damping coefficients for internal modes" typedef ^ ^ INTEGER Members {:}{:} - - "Member joints connection" typedef ^ ^ INTEGER Interf {:}{:} - - "Interface degree of freedoms" -typedef ^ ^ CHARACTER(10) SSOutList {:} - - "List of Output Channels" +typedef ^ ^ CHARACTER(ChanLen) SSOutList {:} - - "List of Output Channels" typedef ^ ^ LOGICAL OutCOSM - - - "Output Cos-matrices Flag" typedef ^ ^ LOGICAL TabDelim - - - "Generate a tab-delimited output file in OutJckF-Flag" #-------------------------- arrays and variables used in the module ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index d7ce80aaee..31efd0db7d 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -45,8 +45,8 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_InitOutputType ======= TYPE, PUBLIC :: SD_InitOutputType - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE SD_InitOutputType ! ======================= @@ -126,7 +126,7 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Interf !< Interface degree of freedoms [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] INTEGER(IntKi) :: NNode !< Total number of nodes [-] @@ -377,22 +377,24 @@ SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%SDInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TP_RefPoint))-1 ) = PACK(InData%TP_RefPoint,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TP_RefPoint) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%SDInputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackInitInput SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -408,12 +410,6 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -431,31 +427,26 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%SDInputFile) - OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%SDInputFile) + OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%TP_RefPoint,1) i1_u = UBOUND(OutData%TP_RefPoint,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TP_RefPoint = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TP_RefPoint))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TP_RefPoint) - DEALLOCATE(mask1) - OutData%SubRotateZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackInitInput SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -620,12 +611,12 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -637,12 +628,12 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -687,12 +678,6 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -720,19 +705,12 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -747,19 +725,12 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1070,10 +1041,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutCnt + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1084,8 +1055,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeCnt)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodeCnt))-1 ) = PACK(InData%NodeCnt,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodeCnt) + DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) + IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NodeIDs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1097,8 +1070,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeIDs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodeIDs))-1 ) = PACK(InData%NodeIDs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodeIDs) + DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) + IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElmIDs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1113,8 +1088,12 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElmIDs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmIDs))-1 ) = PACK(InData%ElmIDs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmIDs) + DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) + DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) + IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ElmNds) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1129,13 +1108,21 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElmNds)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmNds))-1 ) = PACK(InData%ElmNds,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmNds) + DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) + DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) + IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmID2s))-1 ) = PACK(InData%ElmID2s,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmID2s) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmNd2s))-1 ) = PACK(InData%ElmNd2s,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmNd2s) + DO i1 = LBOUND(InData%ElmID2s,1), UBOUND(InData%ElmID2s,1) + IntKiBuf(Int_Xferred) = InData%ElmID2s(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%ElmNd2s,1), UBOUND(InData%ElmNd2s,1) + IntKiBuf(Int_Xferred) = InData%ElmNd2s(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%Me) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1155,8 +1142,16 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Me)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Me))-1 ) = PACK(InData%Me,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Me) + DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) + DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) + DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) + DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) + ReKiBuf(Re_Xferred) = InData%Me(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ke) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1177,8 +1172,16 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ke)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ke))-1 ) = PACK(InData%Ke,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ke) + DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) + DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) + DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) + DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) + ReKiBuf(Re_Xferred) = InData%Ke(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1196,15 +1199,37 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Fg))-1 ) = PACK(InData%Fg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Fg) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Me2))-1 ) = PACK(InData%Me2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Me2) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ke2))-1 ) = PACK(InData%Ke2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ke2) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Fg2))-1 ) = PACK(InData%Fg2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Fg2) + DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) + DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) + DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) + ReKiBuf(Re_Xferred) = InData%Fg(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i3 = LBOUND(InData%Me2,3), UBOUND(InData%Me2,3) + DO i2 = LBOUND(InData%Me2,2), UBOUND(InData%Me2,2) + DO i1 = LBOUND(InData%Me2,1), UBOUND(InData%Me2,1) + ReKiBuf(Re_Xferred) = InData%Me2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i3 = LBOUND(InData%Ke2,3), UBOUND(InData%Ke2,3) + DO i2 = LBOUND(InData%Ke2,2), UBOUND(InData%Ke2,2) + DO i1 = LBOUND(InData%Ke2,1), UBOUND(InData%Ke2,1) + ReKiBuf(Re_Xferred) = InData%Ke2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i2 = LBOUND(InData%Fg2,2), UBOUND(InData%Fg2,2) + DO i1 = LBOUND(InData%Fg2,1), UBOUND(InData%Fg2,1) + ReKiBuf(Re_Xferred) = InData%Fg2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_PackMeshAuxDataType SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1220,12 +1245,6 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1243,10 +1262,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutCnt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutCnt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1260,15 +1279,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeCnt)>0) OutData%NodeCnt = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodeCnt))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodeCnt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) + OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs not allocated Int_Xferred = Int_Xferred + 1 @@ -1283,15 +1297,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeIDs)>0) OutData%NodeIDs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodeIDs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodeIDs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) + OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs not allocated Int_Xferred = Int_Xferred + 1 @@ -1309,15 +1318,12 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElmIDs)>0) OutData%ElmIDs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmIDs))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmIDs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) + DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) + OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds not allocated Int_Xferred = Int_Xferred + 1 @@ -1335,38 +1341,25 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElmNds)>0) OutData%ElmNds = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmNds))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmNds) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) + DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) + OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%ElmID2s,1) i1_u = UBOUND(OutData%ElmID2s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ElmID2s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmID2s))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmID2s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElmID2s,1), UBOUND(OutData%ElmID2s,1) + OutData%ElmID2s(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%ElmNd2s,1) i1_u = UBOUND(OutData%ElmNd2s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ElmNd2s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmNd2s))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmNd2s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElmNd2s,1), UBOUND(OutData%ElmNd2s,1) + OutData%ElmNd2s(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1389,15 +1382,16 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Me)>0) OutData%Me = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Me))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Me) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) + DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) + DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) + DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) + OutData%Me(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated Int_Xferred = Int_Xferred + 1 @@ -1421,15 +1415,16 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Ke)>0) OutData%Ke = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ke))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ke) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) + DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) + DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) + DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) + OutData%Ke(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated Int_Xferred = Int_Xferred + 1 @@ -1450,15 +1445,14 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fg)>0) OutData%Fg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Fg))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Fg) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) + DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) + DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) + OutData%Fg(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%Me2,1) i1_u = UBOUND(OutData%Me2,1) @@ -1466,43 +1460,38 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i2_u = UBOUND(OutData%Me2,2) i3_l = LBOUND(OutData%Me2,3) i3_u = UBOUND(OutData%Me2,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%Me2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Me2))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Me2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Me2,3), UBOUND(OutData%Me2,3) + DO i2 = LBOUND(OutData%Me2,2), UBOUND(OutData%Me2,2) + DO i1 = LBOUND(OutData%Me2,1), UBOUND(OutData%Me2,1) + OutData%Me2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%Ke2,1) i1_u = UBOUND(OutData%Ke2,1) i2_l = LBOUND(OutData%Ke2,2) i2_u = UBOUND(OutData%Ke2,2) i3_l = LBOUND(OutData%Ke2,3) i3_u = UBOUND(OutData%Ke2,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%Ke2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ke2))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ke2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Ke2,3), UBOUND(OutData%Ke2,3) + DO i2 = LBOUND(OutData%Ke2,2), UBOUND(OutData%Ke2,2) + DO i1 = LBOUND(OutData%Ke2,1), UBOUND(OutData%Ke2,1) + OutData%Ke2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%Fg2,1) i1_u = UBOUND(OutData%Fg2,1) i2_l = LBOUND(OutData%Fg2,2) i2_u = UBOUND(OutData%Fg2,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Fg2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Fg2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Fg2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Fg2,2), UBOUND(OutData%Fg2,2) + DO i1 = LBOUND(OutData%Fg2,1), UBOUND(OutData%Fg2,1) + OutData%Fg2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_UnPackMeshAuxDataType SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) @@ -1750,8 +1739,8 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DOFM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DOFM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TI2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1765,8 +1754,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI2))-1 ) = PACK(InData%TI2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI2) + DO i2 = LBOUND(InData%TI2,2), UBOUND(InData%TI2,2) + DO i1 = LBOUND(InData%TI2,1), UBOUND(InData%TI2,1) + ReKiBuf(Re_Xferred) = InData%TI2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1781,8 +1774,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBB))-1 ) = PACK(InData%MBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBB) + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1797,8 +1794,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBM))-1 ) = PACK(InData%MBM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBM) + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1813,8 +1814,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBB))-1 ) = PACK(InData%KBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBB) + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,8 +1834,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiL))-1 ) = PACK(InData%PhiL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiL) + DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) + DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) + ReKiBuf(Re_Xferred) = InData%PhiL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1845,8 +1854,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiR))-1 ) = PACK(InData%PhiR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiR) + DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) + DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) + ReKiBuf(Re_Xferred) = InData%PhiR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1858,8 +1871,10 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OmegaL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OmegaL))-1 ) = PACK(InData%OmegaL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OmegaL) + DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) + ReKiBuf(Re_Xferred) = InData%OmegaL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackCB_MatArrays @@ -1876,12 +1891,6 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1897,8 +1906,8 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DOFM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DOFM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1915,15 +1924,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI2)>0) OutData%TI2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TI2,2), UBOUND(OutData%TI2,2) + DO i1 = LBOUND(OutData%TI2,1), UBOUND(OutData%TI2,1) + OutData%TI2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated Int_Xferred = Int_Xferred + 1 @@ -1941,15 +1947,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBB)>0) OutData%MBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated Int_Xferred = Int_Xferred + 1 @@ -1967,15 +1970,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBM)>0) OutData%MBM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated Int_Xferred = Int_Xferred + 1 @@ -1993,15 +1993,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%KBB)>0) OutData%KBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated Int_Xferred = Int_Xferred + 1 @@ -2019,15 +2016,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiL)>0) OutData%PhiL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) + DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) + OutData%PhiL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated Int_Xferred = Int_Xferred + 1 @@ -2045,15 +2039,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiR)>0) OutData%PhiR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) + DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) + OutData%PhiR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated Int_Xferred = Int_Xferred + 1 @@ -2068,15 +2059,10 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%OmegaL)>0) OutData%OmegaL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OmegaL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OmegaL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) + OutData%OmegaL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackCB_MatArrays @@ -2225,11 +2211,13 @@ SUBROUTINE SD_PackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Omega,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Omega)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Omega))-1 ) = PACK(InData%Omega,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Omega) + DO i1 = LBOUND(InData%Omega,1), UBOUND(InData%Omega,1) + ReKiBuf(Re_Xferred) = InData%Omega(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOmega - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOmega + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Modes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2243,8 +2231,12 @@ SUBROUTINE SD_PackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Modes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Modes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Modes))-1 ) = PACK(InData%Modes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Modes) + DO i2 = LBOUND(InData%Modes,2), UBOUND(InData%Modes,2) + DO i1 = LBOUND(InData%Modes,1), UBOUND(InData%Modes,1) + ReKiBuf(Re_Xferred) = InData%Modes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE SD_PackFEM_MatArrays @@ -2261,12 +2253,6 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2295,18 +2281,13 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Omega.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Omega)>0) OutData%Omega = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Omega))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Omega) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Omega,1), UBOUND(OutData%Omega,1) + OutData%Omega(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NOmega = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NOmega = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Modes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2323,15 +2304,12 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Modes)>0) OutData%Modes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Modes))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Modes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Modes,2), UBOUND(OutData%Modes,2) + DO i1 = LBOUND(OutData%Modes,1), UBOUND(OutData%Modes,1) + OutData%Modes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE SD_UnPackFEM_MatArrays @@ -2448,28 +2426,32 @@ SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Shear , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kappa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DirCos))-1 ) = PACK(InData%DirCos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DirCos) + ReKiBuf(Re_Xferred) = InData%Area + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Length + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ixx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Iyy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Jzz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kappa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YoungE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShearG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rho + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) + DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) + ReKiBuf(Re_Xferred) = InData%DirCos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_PackElemPropType SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2485,12 +2467,6 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2506,39 +2482,36 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Area = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Length = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ixx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Iyy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Jzz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Shear = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Kappa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YoungE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShearG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rho = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Area = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ixx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Iyy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Jzz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) + Int_Xferred = Int_Xferred + 1 + OutData%Kappa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YoungE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rho = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%DirCos,1) i1_u = UBOUND(OutData%DirCos,1) i2_l = LBOUND(OutData%DirCos,2) i2_u = UBOUND(OutData%DirCos,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DirCos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DirCos))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DirCos) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) + DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) + OutData%DirCos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_UnPackElemPropType SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -3128,36 +3101,38 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TP_RefPoint))-1 ) = PACK(InData%TP_RefPoint,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TP_RefPoint) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NXPropSets - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NInterf - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CBMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSets + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NXPropSets + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NInterf + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCMass + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCOSMs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FEMMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDiv + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Joints) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3171,8 +3146,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Joints)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Joints))-1 ) = PACK(InData%Joints,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Joints) + DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) + DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) + ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3187,8 +3166,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSets,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PropSets)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PropSets))-1 ) = PACK(InData%PropSets,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PropSets) + DO i2 = LBOUND(InData%PropSets,2), UBOUND(InData%PropSets,2) + DO i1 = LBOUND(InData%PropSets,1), UBOUND(InData%PropSets,1) + ReKiBuf(Re_Xferred) = InData%PropSets(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%XPropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3203,8 +3186,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XPropSets,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XPropSets)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XPropSets))-1 ) = PACK(InData%XPropSets,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XPropSets) + DO i2 = LBOUND(InData%XPropSets,2), UBOUND(InData%XPropSets,2) + DO i1 = LBOUND(InData%XPropSets,1), UBOUND(InData%XPropSets,1) + ReKiBuf(Re_Xferred) = InData%XPropSets(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3219,8 +3206,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%COSMs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%COSMs))-1 ) = PACK(InData%COSMs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%COSMs) + DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) + DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) + ReKiBuf(Re_Xferred) = InData%COSMs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3235,8 +3226,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMass))-1 ) = PACK(InData%CMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMass) + DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) + DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) + ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3248,8 +3243,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%JDampings)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JDampings))-1 ) = PACK(InData%JDampings,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JDampings) + DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) + ReKiBuf(Re_Xferred) = InData%JDampings(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Members) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3264,8 +3261,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Members)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Members))-1 ) = PACK(InData%Members,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Members) + DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) + DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) + IntKiBuf(Int_Xferred) = InData%Members(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Interf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3280,8 +3281,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Interf,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Interf)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Interf))-1 ) = PACK(InData%Interf,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Interf) + DO i2 = LBOUND(InData%Interf,2), UBOUND(InData%Interf,2) + DO i1 = LBOUND(InData%Interf,1), UBOUND(InData%Interf,1) + IntKiBuf(Int_Xferred) = InData%Interf(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3293,25 +3298,25 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) + DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) DO I = 1, LEN(InData%SSOutList) IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutCOSM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NProp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TDOF - Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NProp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TDOF + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3325,8 +3330,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Nodes))-1 ) = PACK(InData%Nodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Nodes) + DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) + DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) + ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Props) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3341,8 +3350,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Props,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Props)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Props))-1 ) = PACK(InData%Props,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Props) + DO i2 = LBOUND(InData%Props,2), UBOUND(InData%Props,2) + DO i1 = LBOUND(InData%Props,1), UBOUND(InData%Props,1) + ReKiBuf(Re_Xferred) = InData%Props(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3357,8 +3370,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K))-1 ) = PACK(InData%K,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K) + DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) + DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) + ReKiBuf(Re_Xferred) = InData%K(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3373,8 +3390,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3386,8 +3407,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F))-1 ) = PACK(InData%F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F) + DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) + ReKiBuf(Re_Xferred) = InData%F(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3399,8 +3422,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FG))-1 ) = PACK(InData%FG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FG) + DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) + ReKiBuf(Re_Xferred) = InData%FG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3415,8 +3440,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElemProps)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ElemProps))-1 ) = PACK(InData%ElemProps,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ElemProps) + DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) + DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) + ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BCs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3431,8 +3460,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BCs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BCs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BCs))-1 ) = PACK(InData%BCs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BCs) + DO i2 = LBOUND(InData%BCs,2), UBOUND(InData%BCs,2) + DO i1 = LBOUND(InData%BCs,1), UBOUND(InData%BCs,1) + IntKiBuf(Int_Xferred) = InData%BCs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%IntFc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3447,8 +3480,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntFc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IntFc)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IntFc))-1 ) = PACK(InData%IntFc,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IntFc) + DO i2 = LBOUND(InData%IntFc,2), UBOUND(InData%IntFc,2) + DO i1 = LBOUND(InData%IntFc,1), UBOUND(InData%IntFc,1) + IntKiBuf(Int_Xferred) = InData%IntFc(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3463,8 +3500,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MemberNodes)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MemberNodes))-1 ) = PACK(InData%MemberNodes,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MemberNodes) + DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) + DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) + IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3479,8 +3520,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodesConnN)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodesConnN))-1 ) = PACK(InData%NodesConnN,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodesConnN) + DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) + DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) + IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3495,11 +3540,15 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodesConnE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodesConnE))-1 ) = PACK(InData%NodesConnE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodesConnE) + DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) + DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) + IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SSSum , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackInitType SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3515,12 +3564,6 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3536,45 +3579,40 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%TP_RefPoint,1) i1_u = UBOUND(OutData%TP_RefPoint,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TP_RefPoint = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TP_RefPoint))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TP_RefPoint) - DEALLOCATE(mask1) - OutData%SubRotateZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NXPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NInterf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NXPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NInterf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCMass = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCOSMs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FEMMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDiv = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3591,15 +3629,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Joints)>0) OutData%Joints = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Joints))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Joints) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) + DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) + OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSets not allocated Int_Xferred = Int_Xferred + 1 @@ -3617,15 +3652,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSets.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PropSets)>0) OutData%PropSets = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PropSets))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PropSets) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PropSets,2), UBOUND(OutData%PropSets,2) + DO i1 = LBOUND(OutData%PropSets,1), UBOUND(OutData%PropSets,1) + OutData%PropSets(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XPropSets not allocated Int_Xferred = Int_Xferred + 1 @@ -3643,15 +3675,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XPropSets.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XPropSets)>0) OutData%XPropSets = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XPropSets))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XPropSets) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XPropSets,2), UBOUND(OutData%XPropSets,2) + DO i1 = LBOUND(OutData%XPropSets,1), UBOUND(OutData%XPropSets,1) + OutData%XPropSets(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated Int_Xferred = Int_Xferred + 1 @@ -3669,15 +3698,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%COSMs)>0) OutData%COSMs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%COSMs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%COSMs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) + DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) + OutData%COSMs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated Int_Xferred = Int_Xferred + 1 @@ -3695,15 +3721,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CMass)>0) OutData%CMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) + DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) + OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated Int_Xferred = Int_Xferred + 1 @@ -3718,15 +3741,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%JDampings)>0) OutData%JDampings = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JDampings))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JDampings) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) + OutData%JDampings(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated Int_Xferred = Int_Xferred + 1 @@ -3744,15 +3762,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Members)>0) OutData%Members = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Members))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Members) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) + DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) + OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Interf not allocated Int_Xferred = Int_Xferred + 1 @@ -3770,15 +3785,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Interf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Interf)>0) OutData%Interf = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Interf))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Interf) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Interf,2), UBOUND(OutData%Interf,2) + DO i1 = LBOUND(OutData%Interf,1), UBOUND(OutData%Interf,1) + OutData%Interf(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated Int_Xferred = Int_Xferred + 1 @@ -3793,32 +3805,25 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) + DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) DO I = 1, LEN(OutData%SSOutList) OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%OutCOSM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NElem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NProp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + OutData%NNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NProp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3835,15 +3840,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Nodes)>0) OutData%Nodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Nodes))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Nodes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) + DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) + OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Props not allocated Int_Xferred = Int_Xferred + 1 @@ -3861,15 +3863,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Props.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Props)>0) OutData%Props = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Props))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Props) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Props,2), UBOUND(OutData%Props,2) + DO i1 = LBOUND(OutData%Props,1), UBOUND(OutData%Props,1) + OutData%Props(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated Int_Xferred = Int_Xferred + 1 @@ -3887,15 +3886,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K)>0) OutData%K = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) + DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) + OutData%K(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -3913,15 +3909,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated Int_Xferred = Int_Xferred + 1 @@ -3936,15 +3929,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F)>0) OutData%F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) + OutData%F(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated Int_Xferred = Int_Xferred + 1 @@ -3959,15 +3947,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FG)>0) OutData%FG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) + OutData%FG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated Int_Xferred = Int_Xferred + 1 @@ -3985,15 +3968,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElemProps)>0) OutData%ElemProps = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ElemProps))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ElemProps) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) + DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) + OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BCs not allocated Int_Xferred = Int_Xferred + 1 @@ -4011,15 +3991,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BCs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BCs)>0) OutData%BCs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BCs))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BCs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BCs,2), UBOUND(OutData%BCs,2) + DO i1 = LBOUND(OutData%BCs,1), UBOUND(OutData%BCs,1) + OutData%BCs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntFc not allocated Int_Xferred = Int_Xferred + 1 @@ -4037,15 +4014,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntFc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%IntFc)>0) OutData%IntFc = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IntFc))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IntFc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%IntFc,2), UBOUND(OutData%IntFc,2) + DO i1 = LBOUND(OutData%IntFc,1), UBOUND(OutData%IntFc,1) + OutData%IntFc(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -4063,15 +4037,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MemberNodes)>0) OutData%MemberNodes = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MemberNodes))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MemberNodes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) + DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) + OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated Int_Xferred = Int_Xferred + 1 @@ -4089,15 +4060,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%NodesConnN)>0) OutData%NodesConnN = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodesConnN))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodesConnN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) + DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) + OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated Int_Xferred = Int_Xferred + 1 @@ -4115,18 +4083,15 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%NodesConnE)>0) OutData%NodesConnE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodesConnE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodesConnE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) + DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) + OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%SSSum = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackInitType SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4269,8 +4234,10 @@ SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qm))-1 ) = PACK(InData%qm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qm) + DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) + ReKiBuf(Re_Xferred) = InData%qm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4282,8 +4249,10 @@ SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdot))-1 ) = PACK(InData%qmdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdot) + DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) + ReKiBuf(Re_Xferred) = InData%qmdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackContState @@ -4300,12 +4269,6 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4333,15 +4296,10 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qm)>0) OutData%qm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) + OutData%qm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated Int_Xferred = Int_Xferred + 1 @@ -4356,15 +4314,10 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdot)>0) OutData%qmdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) + OutData%qmdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackContState @@ -4459,8 +4412,8 @@ SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackDiscState SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4476,12 +4429,6 @@ SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' @@ -4495,8 +4442,8 @@ SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackDiscState SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4590,8 +4537,8 @@ SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackConstrState SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4607,12 +4554,6 @@ SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' @@ -4626,8 +4567,8 @@ SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackConstrState SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4809,8 +4750,8 @@ SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackOtherState SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4826,12 +4767,6 @@ SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4902,8 +4837,8 @@ SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackOtherState SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -5196,15 +5131,23 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdotdot))-1 ) = PACK(InData%qmdotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdotdot) + DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) + ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%u_TP))-1 ) = PACK(InData%u_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%u_TP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%udot_TP))-1 ) = PACK(InData%udot_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%udot_TP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%udotdot_TP))-1 ) = PACK(InData%udotdot_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%udotdot_TP) + DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) + ReKiBuf(Re_Xferred) = InData%u_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) + ReKiBuf(Re_Xferred) = InData%udot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) + ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%UFL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5215,8 +5158,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UFL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UFL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UFL))-1 ) = PACK(InData%UFL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UFL) + DO i1 = LBOUND(InData%UFL,1), UBOUND(InData%UFL,1) + ReKiBuf(Re_Xferred) = InData%UFL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5228,8 +5173,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar))-1 ) = PACK(InData%UR_bar,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar) + DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) + ReKiBuf(Re_Xferred) = InData%UR_bar(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5241,8 +5188,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar_dot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar_dot))-1 ) = PACK(InData%UR_bar_dot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar_dot) + DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5254,8 +5203,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar_dotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar_dotdot))-1 ) = PACK(InData%UR_bar_dotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar_dotdot) + DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5267,8 +5218,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL))-1 ) = PACK(InData%UL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL) + DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) + ReKiBuf(Re_Xferred) = InData%UL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5280,8 +5233,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL_dot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL_dot))-1 ) = PACK(InData%UL_dot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL_dot) + DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) + ReKiBuf(Re_Xferred) = InData%UL_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5293,8 +5248,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL_dotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL_dotdot))-1 ) = PACK(InData%UL_dotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL_dotdot) + DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5306,13 +5263,15 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SDWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SDWrOutput))-1 ) = PACK(InData%SDWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SDWrOutput) + DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Decimat - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Decimat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackMisc SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5328,12 +5287,6 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5361,49 +5314,29 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdotdot)>0) OutData%qmdotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) + OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%u_TP,1) i1_u = UBOUND(OutData%u_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%u_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%u_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%u_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) + OutData%u_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%udot_TP,1) i1_u = UBOUND(OutData%udot_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%udot_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%udot_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%udot_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) + OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%udotdot_TP,1) i1_u = UBOUND(OutData%udotdot_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%udotdot_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%udotdot_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%udotdot_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) + OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UFL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5417,15 +5350,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UFL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UFL)>0) OutData%UFL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UFL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UFL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UFL,1), UBOUND(OutData%UFL,1) + OutData%UFL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated Int_Xferred = Int_Xferred + 1 @@ -5440,15 +5368,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar)>0) OutData%UR_bar = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) + OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated Int_Xferred = Int_Xferred + 1 @@ -5463,15 +5386,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar_dot)>0) OutData%UR_bar_dot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar_dot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar_dot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) + OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated Int_Xferred = Int_Xferred + 1 @@ -5486,15 +5404,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar_dotdot)>0) OutData%UR_bar_dotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar_dotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar_dotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) + OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated Int_Xferred = Int_Xferred + 1 @@ -5509,15 +5422,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL)>0) OutData%UL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) + OutData%UL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated Int_Xferred = Int_Xferred + 1 @@ -5532,15 +5440,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL_dot)>0) OutData%UL_dot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL_dot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL_dot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) + OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated Int_Xferred = Int_Xferred + 1 @@ -5555,15 +5458,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL_dotdot)>0) OutData%UL_dotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL_dotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL_dotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) + OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -5578,20 +5476,15 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SDWrOutput)>0) OutData%SDWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SDWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SDWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) + OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastOutTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Decimat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackMisc SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -6669,10 +6562,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SttcSolve , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SDDeltaT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SttcSolve, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NOmegaM2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6683,8 +6576,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NOmegaM2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NOmegaM2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NOmegaM2))-1 ) = PACK(InData%NOmegaM2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NOmegaM2) + DO i1 = LBOUND(InData%NOmegaM2,1), UBOUND(InData%NOmegaM2,1) + ReKiBuf(Re_Xferred) = InData%NOmegaM2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%N2OmegaMJDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6696,8 +6591,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%N2OmegaMJDamp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%N2OmegaMJDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%N2OmegaMJDamp))-1 ) = PACK(InData%N2OmegaMJDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%N2OmegaMJDamp) + DO i1 = LBOUND(InData%N2OmegaMJDamp,1), UBOUND(InData%N2OmegaMJDamp,1) + ReKiBuf(Re_Xferred) = InData%N2OmegaMJDamp(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MMB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6712,8 +6609,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MMB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MMB))-1 ) = PACK(InData%MMB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MMB) + DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) + DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) + ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6725,8 +6626,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FX))-1 ) = PACK(InData%FX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FX) + DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) + ReKiBuf(Re_Xferred) = InData%FX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6741,8 +6644,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C1_11)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C1_11))-1 ) = PACK(InData%C1_11,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C1_11) + DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) + DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) + ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6757,8 +6664,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C1_12)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C1_12))-1 ) = PACK(InData%C1_12,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C1_12) + DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) + DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) + ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D1_13) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6773,8 +6684,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_13,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D1_13)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D1_13))-1 ) = PACK(InData%D1_13,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D1_13) + DO i2 = LBOUND(InData%D1_13,2), UBOUND(InData%D1_13,2) + DO i1 = LBOUND(InData%D1_13,1), UBOUND(InData%D1_13,1) + ReKiBuf(Re_Xferred) = InData%D1_13(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D1_14) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6789,8 +6704,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_14,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D1_14)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D1_14))-1 ) = PACK(InData%D1_14,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D1_14) + DO i2 = LBOUND(InData%D1_14,2), UBOUND(InData%D1_14,2) + DO i1 = LBOUND(InData%D1_14,1), UBOUND(InData%D1_14,1) + ReKiBuf(Re_Xferred) = InData%D1_14(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6802,8 +6721,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FY))-1 ) = PACK(InData%FY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FY) + DO i1 = LBOUND(InData%FY,1), UBOUND(InData%FY,1) + ReKiBuf(Re_Xferred) = InData%FY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6818,8 +6739,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiM))-1 ) = PACK(InData%PhiM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiM) + DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) + DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) + ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6834,8 +6759,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C2_61)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C2_61))-1 ) = PACK(InData%C2_61,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C2_61) + DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) + DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) + ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6850,8 +6779,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C2_62)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C2_62))-1 ) = PACK(InData%C2_62,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C2_62) + DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) + DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) + ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6866,8 +6799,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiRb_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiRb_TI))-1 ) = PACK(InData%PhiRb_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiRb_TI) + DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) + DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) + ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6882,8 +6819,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D2_63)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D2_63))-1 ) = PACK(InData%D2_63,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D2_63) + DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) + DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) + ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6898,8 +6839,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D2_64)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D2_64))-1 ) = PACK(InData%D2_64,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D2_64) + DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) + DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) + ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F2_61) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6911,8 +6856,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F2_61,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F2_61)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F2_61))-1 ) = PACK(InData%F2_61,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F2_61) + DO i1 = LBOUND(InData%F2_61,1), UBOUND(InData%F2_61,1) + ReKiBuf(Re_Xferred) = InData%F2_61(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6927,8 +6874,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBB))-1 ) = PACK(InData%MBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBB) + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6943,8 +6894,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBB))-1 ) = PACK(InData%KBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBB) + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6959,8 +6914,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBM))-1 ) = PACK(InData%MBM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBM) + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6975,8 +6934,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiL_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiL_T))-1 ) = PACK(InData%PhiL_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiL_T) + DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) + DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) + ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6991,8 +6954,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiLInvOmgL2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLInvOmgL2))-1 ) = PACK(InData%PhiLInvOmgL2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLInvOmgL2) + DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) + DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) + ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FGL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7004,8 +6971,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FGL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FGL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FGL))-1 ) = PACK(InData%FGL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FGL) + DO i1 = LBOUND(InData%FGL,1), UBOUND(InData%FGL,1) + ReKiBuf(Re_Xferred) = InData%FGL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7020,8 +6989,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AM2Jac)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AM2Jac))-1 ) = PACK(InData%AM2Jac,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AM2Jac) + DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) + DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) + ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7033,8 +7006,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AM2JacPiv)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AM2JacPiv))-1 ) = PACK(InData%AM2JacPiv,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AM2JacPiv) + DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) + IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7049,8 +7024,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) + DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7065,11 +7044,15 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TIreact)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TIreact))-1 ) = PACK(InData%TIreact,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TIreact) + DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) + DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) + ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NModes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NModes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Elems) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7083,27 +7066,31 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Elems)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Elems))-1 ) = PACK(InData%Elems,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Elems) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%qmL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_RbarL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofI - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofR - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NReact - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) + DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) + IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%qmL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_I + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_RbarL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofR + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NReact + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Reacts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7117,17 +7104,21 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Reacts,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Reacts)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Reacts))-1 ) = PACK(InData%Reacts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Reacts) + DO i2 = LBOUND(InData%Reacts,2), UBOUND(InData%Reacts,2) + DO i1 = LBOUND(InData%Reacts,1), UBOUND(InData%Reacts,1) + IntKiBuf(Int_Xferred) = InData%Reacts(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%URbarL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAvgEls - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Nmembers + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%URbarL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAvgEls + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%IDI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7138,8 +7129,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDI)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDI))-1 ) = PACK(InData%IDI,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDI) + DO i1 = LBOUND(InData%IDI,1), UBOUND(InData%IDI,1) + IntKiBuf(Int_Xferred) = InData%IDI(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7151,8 +7144,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDR)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDR))-1 ) = PACK(InData%IDR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDR) + DO i1 = LBOUND(InData%IDR,1), UBOUND(InData%IDR,1) + IntKiBuf(Int_Xferred) = InData%IDR(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7164,8 +7159,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDL)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDL))-1 ) = PACK(InData%IDL,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDL) + DO i1 = LBOUND(InData%IDL,1), UBOUND(InData%IDL,1) + IntKiBuf(Int_Xferred) = InData%IDL(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7177,8 +7174,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDC)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDC))-1 ) = PACK(InData%IDC,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDC) + DO i1 = LBOUND(InData%IDC,1), UBOUND(InData%IDC,1) + IntKiBuf(Int_Xferred) = InData%IDC(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7190,29 +7189,31 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDY)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDY))-1 ) = PACK(InData%IDY,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDY) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%IDY,1), UBOUND(InData%IDY,1) + IntKiBuf(Int_Xferred) = InData%IDY(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnJckF + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7418,16 +7419,16 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutReact , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutDec - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllInt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllDims + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackParam SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7443,12 +7444,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7464,10 +7459,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SDDeltaT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%SttcSolve = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%SDDeltaT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%SttcSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%SttcSolve) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NOmegaM2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7481,15 +7476,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NOmegaM2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NOmegaM2)>0) OutData%NOmegaM2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NOmegaM2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%NOmegaM2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NOmegaM2,1), UBOUND(OutData%NOmegaM2,1) + OutData%NOmegaM2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! N2OmegaMJDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7494,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%N2OmegaMJDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%N2OmegaMJDamp)>0) OutData%N2OmegaMJDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%N2OmegaMJDamp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%N2OmegaMJDamp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%N2OmegaMJDamp,1), UBOUND(OutData%N2OmegaMJDamp,1) + OutData%N2OmegaMJDamp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated Int_Xferred = Int_Xferred + 1 @@ -7530,15 +7515,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MMB)>0) OutData%MMB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MMB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MMB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) + DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) + OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated Int_Xferred = Int_Xferred + 1 @@ -7553,15 +7535,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FX)>0) OutData%FX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) + OutData%FX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated Int_Xferred = Int_Xferred + 1 @@ -7579,15 +7556,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C1_11)>0) OutData%C1_11 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C1_11))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C1_11) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) + DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) + OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated Int_Xferred = Int_Xferred + 1 @@ -7605,15 +7579,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C1_12)>0) OutData%C1_12 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C1_12))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C1_12) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) + DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) + OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_13 not allocated Int_Xferred = Int_Xferred + 1 @@ -7631,15 +7602,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_13.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D1_13)>0) OutData%D1_13 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D1_13))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D1_13) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D1_13,2), UBOUND(OutData%D1_13,2) + DO i1 = LBOUND(OutData%D1_13,1), UBOUND(OutData%D1_13,1) + OutData%D1_13(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_14 not allocated Int_Xferred = Int_Xferred + 1 @@ -7657,15 +7625,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_14.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D1_14)>0) OutData%D1_14 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D1_14))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D1_14) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D1_14,2), UBOUND(OutData%D1_14,2) + DO i1 = LBOUND(OutData%D1_14,1), UBOUND(OutData%D1_14,1) + OutData%D1_14(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FY not allocated Int_Xferred = Int_Xferred + 1 @@ -7680,15 +7645,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FY)>0) OutData%FY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) + OutData%FY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM not allocated Int_Xferred = Int_Xferred + 1 @@ -7706,15 +7666,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiM)>0) OutData%PhiM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) + DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) + OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated Int_Xferred = Int_Xferred + 1 @@ -7732,15 +7689,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C2_61)>0) OutData%C2_61 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C2_61))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C2_61) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) + DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) + OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated Int_Xferred = Int_Xferred + 1 @@ -7758,15 +7712,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C2_62)>0) OutData%C2_62 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C2_62))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C2_62) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) + DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) + OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -7784,15 +7735,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiRb_TI)>0) OutData%PhiRb_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiRb_TI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiRb_TI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) + DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) + OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated Int_Xferred = Int_Xferred + 1 @@ -7810,15 +7758,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D2_63)>0) OutData%D2_63 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D2_63))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D2_63) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) + DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) + OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated Int_Xferred = Int_Xferred + 1 @@ -7836,15 +7781,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D2_64)>0) OutData%D2_64 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D2_64))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D2_64) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) + DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) + OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F2_61 not allocated Int_Xferred = Int_Xferred + 1 @@ -7859,15 +7801,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F2_61.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F2_61)>0) OutData%F2_61 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F2_61))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F2_61) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F2_61,1), UBOUND(OutData%F2_61,1) + OutData%F2_61(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated Int_Xferred = Int_Xferred + 1 @@ -7885,15 +7822,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBB)>0) OutData%MBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated Int_Xferred = Int_Xferred + 1 @@ -7911,15 +7845,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%KBB)>0) OutData%KBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated Int_Xferred = Int_Xferred + 1 @@ -7937,15 +7868,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBM)>0) OutData%MBM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated Int_Xferred = Int_Xferred + 1 @@ -7963,15 +7891,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiL_T)>0) OutData%PhiL_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiL_T))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiL_T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) + DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) + OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7989,15 +7914,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiLInvOmgL2)>0) OutData%PhiLInvOmgL2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLInvOmgL2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLInvOmgL2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) + DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) + OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FGL not allocated Int_Xferred = Int_Xferred + 1 @@ -8012,15 +7934,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FGL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FGL)>0) OutData%FGL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FGL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FGL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FGL,1), UBOUND(OutData%FGL,1) + OutData%FGL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -8038,15 +7955,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AM2Jac)>0) OutData%AM2Jac = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AM2Jac))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AM2Jac) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) + DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) + OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated Int_Xferred = Int_Xferred + 1 @@ -8061,15 +7975,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AM2JacPiv)>0) OutData%AM2JacPiv = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AM2JacPiv))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AM2JacPiv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) + OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated Int_Xferred = Int_Xferred + 1 @@ -8087,15 +7996,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI)>0) OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated Int_Xferred = Int_Xferred + 1 @@ -8113,18 +8019,15 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TIreact)>0) OutData%TIreact = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TIreact))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TIreact) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) + DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) + OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NModes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8141,34 +8044,31 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Elems)>0) OutData%Elems = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Elems))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Elems) - DEALLOCATE(mask2) - END IF - OutData%qmL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_I = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_L = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_RbarL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofI = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofR = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NReact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) + DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) + OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%qmL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_I = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_RbarL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NReact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Reacts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8185,24 +8085,21 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Reacts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Reacts)>0) OutData%Reacts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Reacts))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Reacts) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Reacts,2), UBOUND(OutData%Reacts,2) + DO i1 = LBOUND(OutData%Reacts,1), UBOUND(OutData%Reacts,1) + OutData%Reacts(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%Nmembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%URbarL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NAvgEls = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Nmembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%URbarL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAvgEls = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8216,15 +8113,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDI)>0) OutData%IDI = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDI))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDI,1), UBOUND(OutData%IDI,1) + OutData%IDI(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR not allocated Int_Xferred = Int_Xferred + 1 @@ -8239,15 +8131,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDR)>0) OutData%IDR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDR))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDR,1), UBOUND(OutData%IDR,1) + OutData%IDR(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL not allocated Int_Xferred = Int_Xferred + 1 @@ -8262,15 +8149,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDL)>0) OutData%IDL = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDL))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDL,1), UBOUND(OutData%IDL,1) + OutData%IDL(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC not allocated Int_Xferred = Int_Xferred + 1 @@ -8285,15 +8167,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDC)>0) OutData%IDC = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDC))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDC,1), UBOUND(OutData%IDC,1) + OutData%IDC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDY not allocated Int_Xferred = Int_Xferred + 1 @@ -8308,36 +8185,31 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDY)>0) OutData%IDY = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDY))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDY) - DEALLOCATE(mask1) - END IF - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%IDY,1), UBOUND(OutData%IDY,1) + OutData%IDY(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnJckF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8618,16 +8490,16 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllInt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllDims = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackParam SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -8833,12 +8705,6 @@ SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' @@ -9153,8 +9019,10 @@ SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackOutput @@ -9171,12 +9039,6 @@ SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -9284,15 +9146,10 @@ SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackOutput @@ -9371,8 +9228,8 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -9387,6 +9244,8 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -9420,8 +9279,9 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' @@ -9443,6 +9303,8 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -9524,12 +9386,12 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9542,17 +9404,17 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SD_Output_ExtrapInterp1 @@ -9583,13 +9445,14 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9608,18 +9471,18 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SD_Output_ExtrapInterp2 diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 22edf3d7e7..0f3078661c 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -186,10 +186,10 @@ SUBROUTINE SC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SC_PackInitInput SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -205,12 +205,6 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -225,25 +219,52 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC END SUBROUTINE SC_UnPackInitInput - SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC END SUBROUTINE SC_C2Fary_CopyInitInput + SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC + END SUBROUTINE SC_F2C_CopyInitInput + SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SC_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -400,12 +421,6 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitOutput' @@ -461,15 +476,40 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE SC_UnPackInitOutput - SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF END SUBROUTINE SC_C2Fary_CopyInitOutput + SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + END SUBROUTINE SC_F2C_CopyInitOutput + SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_ParameterType), INTENT(IN) :: SrcParamData TYPE(SC_ParameterType), INTENT(INOUT) :: DstParamData @@ -564,8 +604,8 @@ SUBROUTINE SC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%scOn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%scOn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SC_PackParam SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -581,12 +621,6 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackParam' @@ -600,21 +634,47 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%scOn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%scOn = TRANSFER(IntKiBuf(Int_Xferred), OutData%scOn) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%scOn = OutData%scOn END SUBROUTINE SC_UnPackParam - SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ParamData%scOn = ParamData%C_obj%scOn END SUBROUTINE SC_C2Fary_CopyParam + SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%scOn = ParamData%scOn + END SUBROUTINE SC_F2C_CopyParam + SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_InputType), INTENT(IN) :: SrcInputData TYPE(SC_InputType), INTENT(INOUT) :: DstInputData @@ -743,8 +803,10 @@ SUBROUTINE SC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%toSC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%toSC))-1 ) = PACK(InData%toSC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%toSC) + DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) + ReKiBuf(Re_Xferred) = InData%toSC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_PackInput @@ -761,12 +823,6 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -797,34 +853,68 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%toSC)>0) OutData%toSC = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%toSC))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%toSC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) + OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_UnPackInput - SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- toSC Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) + END IF END IF END SUBROUTINE SC_C2Fary_CopyInput + SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN + InputData%c_obj%toSC_Len = 0 + InputData%c_obj%toSC = C_NULL_PTR + ELSE + InputData%c_obj%toSC_Len = SIZE(InputData%toSC) + IF (InputData%c_obj%toSC_Len > 0) & + InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) + END IF + END IF + END SUBROUTINE SC_F2C_CopyInput + SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_OutputType), INTENT(IN) :: SrcOutputData TYPE(SC_OutputType), INTENT(INOUT) :: DstOutputData @@ -953,8 +1043,10 @@ SUBROUTINE SC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fromSC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fromSC))-1 ) = PACK(InData%fromSC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fromSC) + DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) + ReKiBuf(Re_Xferred) = InData%fromSC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_PackOutput @@ -971,12 +1063,6 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1007,34 +1093,68 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fromSC)>0) OutData%fromSC = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fromSC))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fromSC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) + OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_UnPackOutput - SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- fromSC Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) + END IF END IF END SUBROUTINE SC_C2Fary_CopyOutput + SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN + OutputData%c_obj%fromSC_Len = 0 + OutputData%c_obj%fromSC = C_NULL_PTR + ELSE + OutputData%c_obj%fromSC_Len = SIZE(OutputData%fromSC) + IF (OutputData%c_obj%fromSC_Len > 0) & + OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) + END IF + END IF + END SUBROUTINE SC_F2C_CopyOutput + SUBROUTINE SC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -1110,12 +1230,12 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1128,13 +1248,13 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - ALLOCATE(b1(SIZE(u_out%toSC,1))) - ALLOCATE(c1(SIZE(u_out%toSC,1))) - b1 = -(u1%toSC - u2%toSC)/t(2) - u_out%toSC = u1%toSC + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) + b = -(u1%toSC(i1) - u2%toSC(i1)) + u_out%toSC(i1) = u1%toSC(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SC_Input_ExtrapInterp1 @@ -1165,13 +1285,14 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1190,14 +1311,14 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - ALLOCATE(b1(SIZE(u_out%toSC,1))) - ALLOCATE(c1(SIZE(u_out%toSC,1))) - b1 = (t(3)**2*(u1%toSC - u2%toSC) + t(2)**2*(-u1%toSC + u3%toSC))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%toSC + t(3)*u2%toSC - t(2)*u3%toSC ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%toSC = u1%toSC + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) + b = (t(3)**2*(u1%toSC(i1) - u2%toSC(i1)) + t(2)**2*(-u1%toSC(i1) + u3%toSC(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%toSC(i1) + t(3)*u2%toSC(i1) - t(2)*u3%toSC(i1) ) * scaleFactor + u_out%toSC(i1) = u1%toSC(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SC_Input_ExtrapInterp2 @@ -1276,12 +1397,12 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1294,13 +1415,13 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - ALLOCATE(b1(SIZE(y_out%fromSC,1))) - ALLOCATE(c1(SIZE(y_out%fromSC,1))) - b1 = -(y1%fromSC - y2%fromSC)/t(2) - y_out%fromSC = y1%fromSC + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) + b = -(y1%fromSC(i1) - y2%fromSC(i1)) + y_out%fromSC(i1) = y1%fromSC(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SC_Output_ExtrapInterp1 @@ -1331,13 +1452,14 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1356,14 +1478,14 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - ALLOCATE(b1(SIZE(y_out%fromSC,1))) - ALLOCATE(c1(SIZE(y_out%fromSC,1))) - b1 = (t(3)**2*(y1%fromSC - y2%fromSC) + t(2)**2*(-y1%fromSC + y3%fromSC))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%fromSC + t(3)*y2%fromSC - t(2)*y3%fromSC ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%fromSC = y1%fromSC + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) + b = (t(3)**2*(y1%fromSC(i1) - y2%fromSC(i1)) + t(2)**2*(-y1%fromSC(i1) + y3%fromSC(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%fromSC(i1) + t(3)*y2%fromSC(i1) - t(2)*y3%fromSC(i1) ) * scaleFactor + y_out%fromSC(i1) = y1%fromSC(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SC_Output_ExtrapInterp2 diff --git a/modules/turbsim/src/TurbSim.f90 b/modules/turbsim/src/TurbSim.f90 index 9cdbf4a573..e07223fa27 100644 --- a/modules/turbsim/src/TurbSim.f90 +++ b/modules/turbsim/src/TurbSim.f90 @@ -84,6 +84,7 @@ PROGRAM TurbSim CHARACTER(MaxMsgLen) :: ErrMsg ! error message CHARACTER(200) :: InFile ! Name of the TurbSim input file. CHARACTER(200) :: git_commit ! String containing the current git commit hash +CHARACTER(20) :: FlagArg ! flag argument from command line !BONNIE:***************************** @@ -95,21 +96,19 @@ PROGRAM TurbSim ! ... Initialize NWTC Library (open console, set pi constants) ... CALL NWTC_Init( ProgNameIN=TurbSim_Ver%Name, EchoLibVer=.FALSE. ) + ! Check for command line arguments. +InFile = 'TurbSim.inp' ! default name for input file +CALL CheckArgs( InFile, Flag=FlagArg ) +IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() ! Print out program name, version, and date. ! Display the copyright notice - CALL DispCopyrightLicense( TurbSim_Ver ) + CALL DispCopyrightLicense( TurbSim_Ver%Name ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running - CALL WrScr( ' Running '//GetNVD( TurbSim_Ver )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) - - - - ! Check for command line arguments. -InFile = 'TurbSim.inp' ! default name for input file -CALL CheckArgs( InFile ) + CALL WrScr( ' Running '//TRIM( TurbSim_Ver%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) CALL GetRoot( InFile, p%RootName ) diff --git a/modules/version/CMakeLists.txt b/modules/version/CMakeLists.txt index 63e280e001..1a1b0af02d 100644 --- a/modules/version/CMakeLists.txt +++ b/modules/version/CMakeLists.txt @@ -14,8 +14,17 @@ # limitations under the License. # -include(GetGitRevisionDescription) -git_describe(GIT_DESCRIBE) +# Allow the git-version information to be set externally for the +# package manager distributions (homebrew, conda, apt) that download +# the tarball source code rather than clone with git. +if( DEFINED GIT_DESCRIBE ) + message( WARNING + "Version information has been set as a CMake flag. This should only used when the git-version cannot be set automatically." + ) +else() + include(GetGitRevisionDescription) + git_describe(GIT_DESCRIBE) +endif() add_definitions(-DGIT_VERSION_INFO="${GIT_DESCRIBE}") add_library(versioninfolib src/VersionInfo.f90) diff --git a/modules/version/src/VersionInfo.f90 b/modules/version/src/VersionInfo.f90 index a462697a99..27dbc73e7b 100644 --- a/modules/version/src/VersionInfo.f90 +++ b/modules/version/src/VersionInfo.f90 @@ -28,6 +28,7 @@ FUNCTION QueryGitVersion() CHARACTER(200) :: QueryGitVersion +! The Visual Studio project sets the path for where to find the header file with version info #ifdef GIT_INCLUDE_FILE #include GIT_INCLUDE_FILE #endif diff --git a/reg_tests/CMakeLists.txt b/reg_tests/CMakeLists.txt index d29d5b5bca..6272de3e4c 100644 --- a/reg_tests/CMakeLists.txt +++ b/reg_tests/CMakeLists.txt @@ -40,6 +40,9 @@ set(CTEST_OPENFAST_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast/openfast" # Set the BeamDyn executable configuration option and default set(CTEST_BEAMDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/beamdyn/beamdyn_driver" CACHE FILEPATH "Specify the BeamDyn driver executable to use in testing.") +# Set the HydroDyn executable configuration option and default +set(CTEST_HYDRODYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/hydrodyn/hydrodyn_driver" CACHE FILEPATH "Specify the HydroDyn driver executable to use in testing.") + # Set the python executable configuration option and default if(NOT EXISTS ${PYTHON_EXECUTABLE}) find_program(PYTHON_EXECUTABLE NAMES python3 python py) @@ -61,7 +64,7 @@ add_subdirectory("${CMAKE_CURRENT_LIST_DIR}/r-test") # build and seed the test directories with the data they need to run the tests file(MAKE_DIRECTORY ${CTEST_BINARY_DIR}) -foreach(regTest glue-codes/openfast modules/beamdyn) +foreach(regTest glue-codes/openfast modules/beamdyn modules/hydrodyn) file(MAKE_DIRECTORY ${CTEST_BINARY_DIR}/${regTest}) endforeach() diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index ba8629b4c7..c0c1c03c03 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -65,6 +65,16 @@ function(of_regression TESTNAME LABEL) regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") endfunction(of_regression) +# openfast aeroacoustic +function(of_regression_aeroacoustic TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastAeroAcousticRegressionCase.py") + set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") +endfunction(of_regression_aeroacoustic) + +# beamdyn # openfast linearized function(of_regression_linear TESTNAME LABEL) set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastLinearRegressionCase.py") @@ -83,6 +93,15 @@ function(bd_regression TESTNAME LABEL) regression(${TEST_SCRIPT} ${BEAMDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") endfunction(bd_regression) +# hydrodyn +function(hd_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeHydrodynRegressionCase.py") + set(HYDRODYN_EXECUTABLE "${CTEST_HYDRODYN_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/hydrodyn") + regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") +endfunction(hd_regression) + #=============================================================================== # Regression tests #=============================================================================== @@ -102,7 +121,7 @@ of_regression("WP_VSP_WTurb_PitchFail" "openfast;elastodyn;aerodyn14;se 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;aerodyn15;servodyn") +of_regression("SWRT_YFree_VS_EDC01" "openfast;elastodyn;aerodyn14;servodyn") of_regression("SWRT_YFree_VS_WTurb" "openfast;elastodyn;aerodyn14;servodyn") of_regression("5MW_Land_DLL_WTurb" "openfast;elastodyn;aerodyn15;servodyn") of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn") @@ -113,12 +132,19 @@ of_regression("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "openfast;elastodyn;aerod of_regression("5MW_OC3Spar_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;map") of_regression("5MW_OC4Semi_WSt_WavesWN" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;moordyn") of_regression("5MW_Land_BD_DLL_WTurb" "openfast;beamdyn;aerodyn15;servodyn") +of_regression("5MW_OC4Jckt_ExtPtfm" "openfast;elastodyn;extptfm") +of_regression("HelicalWake_OLAF" "openfast;aerodyn15;olaf") +of_regression("EllipticalWing_OLAF" "openfast;aerodyn15;olaf") + +# AeroAcoustic regression test +of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") # Linearized OpenFAST regression tests -of_regression_linear("WP_Stationary_Linear" "openfast;linear;elastodyn;aerodyn15") +of_regression_linear("WP_Stationary_Linear" "openfast;linear;elastodyn") of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "openfast;linear;beamdyn") of_regression_linear("Ideal_Beam_Free_Free_Linear" "openfast;linear;beamdyn") of_regression_linear("5MW_Land_BD_Linear" "openfast;linear;beamdyn;servodyn") +of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;servodyn") # BeamDyn regression tests bd_regression("bd_5MW_dynamic" "beamdyn;dynamic") @@ -128,3 +154,6 @@ bd_regression("bd_curved_beam" "beamdyn;static") bd_regression("bd_isotropic_rollup" "beamdyn;static") bd_regression("bd_static_cantilever_beam" "beamdyn;static") bd_regression("bd_static_twisted_with_k1" "beamdyn;static") + +# HydroDyn regression tests +hd_regression("hd_OC3tripod_offshore_fixedbottom_wavesirr" "hydrodyn;offshore") diff --git a/reg_tests/README.md b/reg_tests/README.md index e464c60f9e..12f84f2f01 100644 --- a/reg_tests/README.md +++ b/reg_tests/README.md @@ -7,7 +7,7 @@ This directory contains the regression test suite for OpenFAST and its modules. - A `lib` subdirectory with lower level python scripts Dependencies required to run the regression test suite are -- Python 3+ +- Python 3.7+ - Numpy - CMake and CTest - Bokeh 1.4 (optional) diff --git a/reg_tests/executeHydrodynRegressionCase.py b/reg_tests/executeHydrodynRegressionCase.py new file mode 100644 index 0000000000..a18ab1ad91 --- /dev/null +++ b/reg_tests/executeHydrodynRegressionCase.py @@ -0,0 +1,136 @@ +# +# Copyright 2017 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +""" + This program executes HydroDyn and a regression test for a single test case. + The test data is contained in a git submodule, r-test, which must be initialized + prior to running. See the r-test README or OpenFAST documentation for more info. + + Get usage with: `executeHydrodynRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import shutil +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes HydroDyn and a regression test for a single test case.") +parser.add_argument("caseName", metavar="Case-Name", type=str, nargs=1, help="The name of the test case.") +parser.add_argument("executable", metavar="HydroDyn-Driver", type=str, nargs=1, help="The path to the HydroDyn driver executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") +parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") +parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include matplotlib plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +tolerance = args.tolerance[0] +plotError = args.plot if args.plot is False else True +noExec = args.noExec if args.noExec is False else True +verbose = args.verbose if args.verbose is False else True + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "modules", "hydrodyn") +inputsDirectory = os.path.join(moduleDirectory, caseName) +targetOutputDirectory = os.path.join(inputsDirectory) +testBuildDirectory = os.path.join(buildDirectory, caseName) + +# verify all the required directories exist +if not os.path.isdir(rtest): + rtl.exitWithError("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(rtest)) +if not os.path.isdir(targetOutputDirectory): + rtl.exitWithError("The test data outputs directory, {}, does not exist. Try running `git submodule update`".format(targetOutputDirectory)) +if not os.path.isdir(inputsDirectory): + rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) + +# create the local output directory if it does not already exist +# and initialize it with input files for all test cases +if not os.path.isdir(testBuildDirectory): + os.makedirs(testBuildDirectory) + shutil.copy(os.path.join(inputsDirectory,"hd_driver.inp"), os.path.join(testBuildDirectory,"hd_driver.inp")) + shutil.copy(os.path.join(inputsDirectory,"hd_primary.inp"), os.path.join(testBuildDirectory,"hd_primary.inp")) + +### Run HydroDyn on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "hd_driver.inp") + returnCode = openfastDrivers.runHydrodynDriverCase(caseInputFile, executable) + if returnCode != 0: + rtl.exitWithError("") + +### Build the filesystem navigation variables for running the regression test +localOutFile = os.path.join(testBuildDirectory, "driver.HD.out") +baselineOutFile = os.path.join(targetOutputDirectory, "driver.HD.out") +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) +performance = pass_fail.calculateNorms(testData, baselineData) +normalizedNorm = performance[:, 1] + +# export all case summaries +results = list(zip(testInfo["attribute_names"], [*performance])) +results_max = performance.max(axis=0) +exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) + +# failing case +if not pass_fail.passRegressionTest(normalizedNorm, tolerance): + if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] + failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] + failResults = [res for i, res in enumerate(results) if i in ixFailChannels] + for channel in failChannels: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error.msg)) + finalizePlotDirectory(localOutFile, failChannels, caseName) + sys.exit(1) + +# passing case +sys.exit(0) diff --git a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py new file mode 100644 index 0000000000..ccb9de8cd5 --- /dev/null +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -0,0 +1,169 @@ +# +# Copyright 2017 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +""" + This program executes OpenFAST and a regression test for a single test case with + the aero-acoustics module in AeroDyn15. + The test data is contained in a git submodule, r-test, which must be initialized + prior to running. See the r-test README or OpenFAST documentation for more info. + + Get usage with: `executeOpenfastAeroAcousticRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import shutil +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Helper functions +def ignoreBaselineItems(directory, contents): + itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] + caught = [] + for c in contents: + if c in itemFilter: + caught.append(c) + return tuple(caught) + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes OpenFAST and a regression test for a single test case.") +parser.add_argument("caseName", metavar="Case-Name", type=str, nargs=1, help="The name of the test case.") +parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") +parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") +parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +tolerance = args.tolerance[0] +systemName = args.systemName[0] +compilerId = args.compilerId[0] +plotError = args.plot +noExec = args.noExec +verbose = args.verbose + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory) + +### Map the system and compiler configurations to a solution set +# Internal names -> Human readable names +systemName_map = { + "darwin": "macos", + "linux": "linux", + "windows": "windows" +} +compilerId_map = { + "gnu": "gnu", + "intel": "intel" +} +# Build the target output directory name or choose the default +supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] +targetSystem = systemName_map.get(systemName.lower(), "") +targetCompiler = compilerId_map.get(compilerId.lower(), "") +outputType = os.path.join(targetSystem+"-"+targetCompiler) +if outputType not in supportedBaselines: + outputType = supportedBaselines[0] +print("-- Using gold standard files with machine-compiler type {}".format(outputType)) + +### Build the filesystem navigation variables for running openfast on the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "glue-codes", "openfast") +inputsDirectory = os.path.join(moduleDirectory, caseName) +targetOutputDirectory = os.path.join(inputsDirectory, outputType) +testBuildDirectory = os.path.join(buildDirectory, caseName) + + + +# verify all the required directories exist +if not os.path.isdir(rtest): + rtl.exitWithError("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(rtest)) +if not os.path.isdir(targetOutputDirectory): + rtl.exitWithError("The test data outputs directory, {}, does not exist. Try running `git submodule update`".format(targetOutputDirectory)) +if not os.path.isdir(inputsDirectory): + rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) + +# create the local output directory if it does not already exist +# and initialize it with input files for all test cases +if not os.path.isdir(testBuildDirectory): + shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) + +### Run openfast on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") + returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) + if returnCode != 0: + rtl.exitWithError("") + +### Build the filesystem navigation variables for running the regression test +# testing on file 2. Gives each observer and sweep of frequency ranges +localOutFile = os.path.join(testBuildDirectory, caseName + "_2.out") +baselineOutFile = os.path.join(targetOutputDirectory, caseName + "_2.out") +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) +performance = pass_fail.calculateNorms(testData, baselineData) +normalizedNorm = performance[:, 1] + +# export all case summaries +results = list(zip(testInfo["attribute_names"], [*performance])) +results_max = performance.max(axis=0) +exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) + +# failing case +if not pass_fail.passRegressionTest(normalizedNorm, tolerance): + if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] + failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] + failResults = [res for i, res in enumerate(results) if i in ixFailChannels] + for channel in failChannels: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error.msg)) + finalizePlotDirectory(localOutFile, failChannels, caseName) + sys.exit(1) + +# passing case +sys.exit(0) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 4f0fd0f703..11c7671e11 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -142,7 +142,7 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): else: names = os.listdir(src) for name in names: - if name is "ServoData": + if name == "ServoData": continue srcname = os.path.join(src, name) dstname = os.path.join(dst, name) @@ -198,16 +198,16 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): local_handle.readline() # the next 10 lines are simulation info; save what we need - for i in range(10): + for i in range(11): b_line = baseline_handle.readline() l_line = local_handle.readline() - if i == 4: + if i == 5: b_num_continuous_states = int(b_line.split()[-1]) l_num_continuous_states = int(l_line.split()[-1]) - elif i == 7: + elif i == 8: b_num_inputs = int(b_line.split()[-1]) l_num_inputs = int(l_line.split()[-1]) - elif i == 8: + elif i == 9: b_num_outputs = int(b_line.split()[-1]) l_num_outputs = int(l_line.split()[-1]) @@ -237,6 +237,7 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): l_float = float(l_element) b_float = float(b_elements[j]) if not isclose(l_float, b_float, tolerance, tolerance): + print(f"Failed in Jacobian matrix comparison: {l_float} and {b_float}") sys.exit(1) # skip 2 empty/header lines @@ -258,6 +259,7 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): l_float = float(l_element) b_float = float(b_elements[j]) if not isclose(l_float, b_float, tolerance, tolerance): + print(f"Failed in state matrix comparison: {l_float} and {b_float}") sys.exit(1) local_handle.close() diff --git a/reg_tests/lib/fast_io.py b/reg_tests/lib/fast_io.py index 07b7d74255..c730f99373 100644 --- a/reg_tests/lib/fast_io.py +++ b/reg_tests/lib/fast_io.py @@ -86,11 +86,17 @@ def fread(fid, n, type): FileFmtID_WithTime = 1 # File identifiers used in FAST FileFmtID_WithoutTime = 2 FileFmtID_NoCompressWithoutTime = 3 - LenName = 10 # number of characters per channel name - LenUnit = 10 # number of characters per unit name + FileFmtID_ChanLen_In = 4 with open(filename, 'rb') as fid: FileID = fread(fid, 1, 'int16')[0] # FAST output file format, INT(2) + + if FileID == FileFmtID_ChanLen_In: + LenName = fread(fid, 1, 'int16')[0] # Number of characters in channel names and units + else: + LenName = 10 # default number of characters per channel name + + NumOutChans = fread(fid, 1, 'int32')[0] # The number of output channels, INT(4) NT = fread(fid, 1, 'int32')[0] # The number of time steps, INT(4) @@ -116,7 +122,7 @@ def fread(fid, n, type): ChanUnit = [] # initialize the ChanUnit cell array for iChan in range(NumOutChans + 1): - ChanUnitASCII = fread(fid, LenUnit, 'uint8') # ChanUnit converted to numeric ASCII + ChanUnitASCII = fread(fid, LenName, 'uint8') # ChanUnit converted to numeric ASCII ChanUnit.append("".join(map(chr, ChanUnitASCII)).strip()[1:-1]) # get the channel time series diff --git a/reg_tests/lib/openfastDrivers.py b/reg_tests/lib/openfastDrivers.py index 2642d26afe..e06350eeca 100644 --- a/reg_tests/lib/openfastDrivers.py +++ b/reg_tests/lib/openfastDrivers.py @@ -54,3 +54,8 @@ def runBeamdynDriverCase(inputFile, executable, verbose=False): caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) os.chdir(caseDirectory) return _runGenericCase(inputFile, executable, verbose) + +def runHydrodynDriverCase(inputFile, executable, verbose=False): + caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) + os.chdir(caseDirectory) + return _runGenericCase(inputFile, executable, verbose) diff --git a/reg_tests/r-test b/reg_tests/r-test index 283707d5f3..020c8d29f3 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 283707d5f3a9d8e23acd08c9521fba81d275530a +Subproject commit 020c8d29f30153da4fe35fed6d8a1e8be286052d diff --git a/share/docker/openfast_dev/Dockerfile b/share/docker/openfast_dev/Dockerfile index 997bdc20cb..eea9ec75da 100644 --- a/share/docker/openfast_dev/Dockerfile +++ b/share/docker/openfast_dev/Dockerfile @@ -42,4 +42,4 @@ RUN ctest -VV -L linear ## - 9, 16 because they're very sensitive ## - 19, 20 because theyre too long ## - 17, 22, 23 becuase we dont know why they fail :( -RUN ctest -VV -j8 -I 1,1,1,2,3,4,5,6,7,8,10,11,12,13,14,15,18,21,24,25 +RUN ctest -VV -j8 -I 1,1,1,2,3,4,5,6,7,8,10,11,12,13,14,15,18,21,24,25,27,28,29 diff --git a/unit_tests/CMakeLists.txt b/unit_tests/CMakeLists.txt index ff2cfae7dd..4caee9fa32 100644 --- a/unit_tests/CMakeLists.txt +++ b/unit_tests/CMakeLists.txt @@ -35,6 +35,7 @@ endif() include(ExternalProject) set(ExternalProjectCMakeArgs -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/pfunit + -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} -DROBUST=OFF ) set(PFUNIT_INSTALL ${PROJECT_BINARY_DIR}/pfunit) @@ -70,3 +71,4 @@ endif() ### Add the unit tests here add_subdirectory("beamdyn") add_subdirectory("nwtc-library") +add_subdirectory("aerodyn") diff --git a/unit_tests/README.md b/unit_tests/README.md index 340fd98358..48cc589484 100644 --- a/unit_tests/README.md +++ b/unit_tests/README.md @@ -6,7 +6,7 @@ This directory contains the unit test suite for the OpenFAST framework. Containe - A unit test template file The dependencies for unit testing are: -- Python 3+ +- Python 3.7+ - pFUnit - CMake diff --git a/unit_tests/aerodyn/CMakeLists.txt b/unit_tests/aerodyn/CMakeLists.txt new file mode 100644 index 0000000000..4e0bf86852 --- /dev/null +++ b/unit_tests/aerodyn/CMakeLists.txt @@ -0,0 +1,61 @@ +# +# Copyright 2017 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) + +set(module_name "fvw") +set(module_directory "aerodyn") +set(module_library "fvwlib") + +file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) +file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") + +include_directories( + ${PROJECT_SOURCE_DIR} + ${pfunit_directory}/mod + ${build_testdirectory}/${module_directory} +) + +set(testlist + test_FVW_testsuite +) +foreach(test ${testlist}) + set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) + add_custom_command( + OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 + COMMAND ${PYTHON_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 + DEPENDS ${test_dependency} + ) + set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) + file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") +endforeach() + +add_executable( + ${module_name}_utest + ${pfunit_directory}/include/driver.F90 + ${test_sources} +) + +target_link_libraries( + ${module_name}_utest + ${pfunit_directory}${pfunit_lib} + ${module_library} +) + +add_test( + ${module_name}_utest + ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest +) diff --git a/unit_tests/nwtc-library/CMakeLists.txt b/unit_tests/nwtc-library/CMakeLists.txt index 864597ea28..6138fc7617 100644 --- a/unit_tests/nwtc-library/CMakeLists.txt +++ b/unit_tests/nwtc-library/CMakeLists.txt @@ -32,6 +32,7 @@ include_directories( set(testlist test_NWTC_IO_CheckArgs + test_NWTC_RandomNumber ) foreach(test ${testlist}) set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index 88f796b098..72d14743c4 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -5,7 +5,7 @@ - + @@ -15,7 +15,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -88,6 +88,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -117,25 +148,26 @@ + - - + + - - + + @@ -153,19 +185,19 @@ - - + + - - + + @@ -182,19 +214,19 @@ - - + + - - + + @@ -213,19 +245,19 @@ - - + + - - + + @@ -237,9 +269,375 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -263,19 +661,19 @@ - - + + - - + + diff --git a/vs-build/BeamDyn/BeamDyn-w-registry.sln b/vs-build/BeamDyn/BeamDyn-w-registry.sln index a881f9d525..5c99185653 100644 --- a/vs-build/BeamDyn/BeamDyn-w-registry.sln +++ b/vs-build/BeamDyn/BeamDyn-w-registry.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 +# Visual Studio 15 +VisualStudioVersion = 15.0.28307.902 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "BeamDyn.vfproj", "{815C302F-A93D-4C22-9329-7112345113C0}" ProjectSection(ProjectDependencies) = postProject @@ -38,18 +38,18 @@ Global {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.Build.0 = Release|Win32 {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.ActiveCfg = Release|x64 {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug-Double Precision|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug-Double Precision|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Debug|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Debug|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Debug|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Debug|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release-Double Precision|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release-Double Precision|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|x64 @@ -58,4 +58,7 @@ Global GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {37F40376-E0A4-4BB3-A987-A3CF5A440217} + EndGlobalSection EndGlobal diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index 53d190698d..852d40158e 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -113,6 +113,7 @@ + diff --git a/vs-build/FAST/FAST.sln b/vs-build/FAST/FAST.sln index dfadae1257..ec3d691059 100644 --- a/vs-build/FAST/FAST.sln +++ b/vs-build/FAST/FAST.sln @@ -5,9 +5,7 @@ VisualStudioVersion = 15.0.27428.2043 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST", "FAST.vfproj", "{18AE8067-CCC6-4479-A0DB-C4089EF9FE71}" ProjectSection(ProjectDependencies) = postProject - {BF86702A-CB17-4050-8AE9-078CDC5910D3} = {BF86702A-CB17-4050-8AE9-078CDC5910D3} {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} = {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} EndProjectSection EndProject Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FASTlib", "..\FASTlib\FASTlib.vfproj", "{1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}" diff --git a/vs-build/FAST/FAST.vfproj b/vs-build/FAST/FAST.vfproj index 80f4de20ce..b9c9ca2a94 100644 --- a/vs-build/FAST/FAST.vfproj +++ b/vs-build/FAST/FAST.vfproj @@ -15,7 +15,7 @@ - + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index dfc78ed546..4efd3db98b 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -11,7 +11,7 @@ - + @@ -20,7 +20,7 @@ - + @@ -29,7 +29,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -47,7 +47,7 @@ - + @@ -56,7 +56,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -74,7 +74,7 @@ - + @@ -83,7 +83,7 @@ - + @@ -92,7 +92,7 @@ - + @@ -101,7 +101,7 @@ - + @@ -110,80 +110,117 @@ - + - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + - + - + + + - + - + + + + + - - + + - - - + - + - + + + @@ -199,25 +236,25 @@ - - + + - - - + - + - + + + @@ -230,28 +267,28 @@ - + - - + + - - - + - + - + + + @@ -264,28 +301,62 @@ - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + - + - + + + @@ -299,6 +370,7 @@ + @@ -321,25 +393,25 @@ - - + + - - - + - + - + + + @@ -358,25 +430,25 @@ - - + + - - - + - + - + + + @@ -397,29 +469,30 @@ - - + + - - - + - + - + + + + @@ -427,25 +500,25 @@ - - + + - - - + - + - + + + @@ -460,31 +533,32 @@ + - - + + - - - + - + - + + + @@ -497,31 +571,32 @@ - + + - - + + - - - + - + - + + + @@ -543,25 +618,25 @@ - - + + - - - + - + - + + + @@ -577,25 +652,25 @@ - - + + - - - + - + - + + + @@ -611,25 +686,25 @@ - - + + - - - + - + - + + + @@ -645,25 +720,25 @@ - - + + - - - + - + - + + + @@ -676,28 +751,62 @@ - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + - + - + + + @@ -713,50 +822,50 @@ - - + + - - - + - + - + + + - - + + - - - + - + - + + + @@ -781,50 +890,50 @@ - - + + - - - + - + - + + + - - + + - - - + - + - + + + @@ -853,6 +962,7 @@ + @@ -878,25 +988,25 @@ - - + + - - - + - + - + + + @@ -906,25 +1016,25 @@ - - + + - - - + - + - + + + @@ -955,25 +1065,25 @@ - - + + - - - + - + - + + + @@ -989,25 +1099,25 @@ - - + + - - - + - + - + + + @@ -1023,25 +1133,25 @@ - - + + - - - + - + - + + + @@ -1057,25 +1167,25 @@ - - + + - - - + - + - + + + @@ -1091,25 +1201,25 @@ - - + + - - - + - + - + + + @@ -1125,25 +1235,25 @@ - - + + - - - + - + - + + + @@ -1159,25 +1269,25 @@ - - + + - - - + - + - + + + @@ -1193,25 +1303,25 @@ - - + + - - - + - + - + + + @@ -1239,25 +1349,25 @@ - - + + - - - + - + - + + + @@ -1273,29 +1383,65 @@ - + - + - + - + - + - + - + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -1313,25 +1459,25 @@ - - + + - - - + - + - + + + @@ -1351,25 +1497,25 @@ - - + + - - - + - + - + + + @@ -1388,82 +1534,441 @@ - + - + - + + + - + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + - - - + + - + - + - + + + - + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + - - + + - + - + - + + + - + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -1485,45 +1990,46 @@ + - + - + - - + + - - + + - - - + - + - + + + @@ -1542,25 +2048,25 @@ - - + + - - - + - + - + + + @@ -1576,25 +2082,25 @@ - - + + - - - + - + - + + + @@ -1618,25 +2124,25 @@ - - + + - - - + - + - + + + @@ -1658,25 +2164,25 @@ - - + + - - - + - + - + + + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 6314f9f015..89e4500f42 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -14,9 +14,9 @@ - + - + @@ -52,54 +52,60 @@ - + - + - + - + - + - + - + - + + + + + + + - + - + - + - + - + - + @@ -108,14 +114,14 @@ - + - + - + - + @@ -130,6 +136,7 @@ + @@ -140,6 +147,16 @@ + + + + + + + + + + @@ -225,12 +242,21 @@ + + + + + + + + + - + diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index f1df704eac..0339dfa085 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -1,5 +1,5 @@  - + Debug @@ -71,29 +71,21 @@ true ..\..\build\bin\ MAP_$(PlatformName) - $(VC_IncludePath);$(WindowsSDK_IncludePath);..\..\modules\map\src - $(VC_LibraryPath_x86);$(WindowsSDK_LibraryPath_x86) MAP_$(PlatformName) true ..\..\build\bin\ - $(VC_IncludePath);$(WindowsSDK_IncludePath);..\..\modules\map\src - $(VC_LibraryPath_x64);$(WindowsSDK_LibraryPath_x64) false ..\..\build\bin\ MAP_$(PlatformName) - $(VC_IncludePath);$(WindowsSDK_IncludePath);..\..\modules\map\src - $(VC_LibraryPath_x86);$(WindowsSDK_LibraryPath_x86) MAP_$(PlatformName) false ..\..\build\bin\ - $(VC_IncludePath);$(WindowsSDK_IncludePath);..\..\modules\map\src - $(VC_LibraryPath_x64);$(WindowsSDK_LibraryPath_x64) @@ -134,7 +126,6 @@ WIN32;NDEBUG;_WINDOWS;_USRDLL;MAP_DLL_EXPORTS;CMINPACK_NO_DLL;%(PreprocessorDefinitions) true MultiThreaded - ..\..\modules\map\src Windows @@ -198,7 +189,6 @@ - diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 4421983928..4709404897 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -60,6 +60,7 @@ REM ---------------------------------------------------------------------------- SET CURR_LOC=%MAP_Loc% SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -ccode -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +%REGISTRY% "%CURR_LOC%\MAP_Fortran_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError :FAST @@ -128,7 +129,7 @@ GOTO checkError :AeroDyn_Driver SET CURR_LOC=%AD_Loc% SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I %NWTC_Lib_Loc% -I %CURR_LOC% -O %Output_Loc% -noextrap +%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError :AFI @@ -143,6 +144,18 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\UnsteadyAero_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError +:FVW +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\FVW_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + +:AA +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroAcoustics_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + :AeroDyn14 SET CURR_LOC=%AD14_Loc% SET Output_Loc=%CURR_LOC% @@ -179,6 +192,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError +:SS_Excitation +SET CURR_LOC=%HD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + :SS_Radiation SET CURR_LOC=%HD_Loc% SET Output_Loc=%CURR_LOC% @@ -251,6 +270,10 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" GOTO checkError +:Version +DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" +GOTO end + :checkError ECHO. IF %ERRORLEVEL% NEQ 0 ( @@ -301,4 +324,4 @@ SET ALL_FAST_Includes= echo %lines% set lines= -:PathsOnly \ No newline at end of file +:PathsOnly